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