Re: Partitioning a list into unequal partitions
- To: mathgroup at smc.vnet.net
- Subject: [mg47546] Re: Partitioning a list into unequal partitions
- From: Paul Abbott <paul at physics.uwa.edu.au>
- Date: Thu, 15 Apr 2004 03:41:04 -0400 (EDT)
- Organization: The University of Western Australia
- References: <c5gfdp$an0$1@smc.vnet.net> <c5j8aj$r4t$1@smc.vnet.net>
- Sender: owner-wri-mathgroup at wolfram.com
In article <c5j8aj$r4t$1 at smc.vnet.net>,
Paul Abbott <paul at physics.uwa.edu.au> wrote:
> In article <c5gfdp$an0$1 at smc.vnet.net>, "DIAMOND Mark R." <dot at dot.dot>
> wrote:
>
> > Could someone please show me a simple (non-procedural) way of partitioning a
> > list into 1,2,3 ... n disjoint sublists, where the length of the list is
> > guaranteed to be correct (i.e. n*(n+1)/2)
>
> If I understand your question (a definite example would have helped),
> for a list, lst, how about
>
> Sort[ReplaceList[lst, {___, a__, ___} -> {a}]]
>
> This gives a list of length n*(n+1)/2 if lst is of length n.
It is clear now that I did not understand your question!
> > I can't see a way, and yet I'm sure there *must* be a one-liner using Fold.
>
> I don't see how Fold will do what you want.
Here are three ways (slightly) different to those posted thus far:
Define two utility functions:
tri[n_] := (Sqrt[8 n + 1] - 1)/2
TriangularQ[n_] := IntegerQ[tri[n]]
[1] Use FoldList for indexing:
TriangularList[l_List] := With[{n = tri[Length[l]]}, Take[l, #]& /@
FoldList[Plus, {1, 1}, Transpose[{Range[n - 1], Range[2, n]}]]]
[2] Use a nested Range along with FoldList:
TriangularList[l_List] := Module[{n = tri[Length[l]]},
l[[#]] & /@ (Range[Range[n]] + FoldList[Plus, 0, Range[n - 1]])]
[1] and [2] will truncate a list to the nearest triangular-sized list.
[3] Use Split with a counter:
TriangularList[l_List] := Module[{i=0},Split[l,Not[TriangularQ[++i]]&]]
This will put any extra items into the last list in the output.
Are you trying to pack a list into an upper or lower triangular matrix?
If so you could use SparseArray
lst = CharacterRange["a", "f"];
SparseArray[Flatten[Table[{i,j},{i,tri[Length[lst]]},{j,i}],1] -> lst]
Normal[%]
{{"a", 0, 0}, {"b", "c", 0}, {"d", "e", "f"}}
DeleteCases[%, 0, 2]
{{"a"}, {"b", "c"}, {"d", "e", "f"}}
Cheers,
Paul
--
Paul Abbott Phone: +61 8 9380 2734
School of Physics, M013 Fax: +61 8 9380 1014
The University of Western Australia (CRICOS Provider No 00126G)
35 Stirling Highway
Crawley WA 6009 mailto:paul at physics.uwa.edu.au
AUSTRALIA http://physics.uwa.edu.au/~paul