3

This code generates all "sequential partitions" of a list:

testlist = {a, b, c, d, e};
w = Length[testlist];
breakpoints = Map[Join[#, {w}] &, Subsets[Range[w - 1]]];
partitionfrombreakpoints[breakpointlist_] := 
  Prepend[Map[
    Take[testlist, {breakpointlist[[#]] + 1, 
       breakpointlist[[# + 1]]}] &, 
    Range[Length[breakpointlist] - 1]], 
   Take[testlist, {1, breakpointlist[[1]]}]];
Print[Grid[Map[partitionfrombreakpoints, breakpoints]]];

Like so:

{a,b,c,d,e}             
{a} {b,c,d,e}           
{a,b}   {c,d,e}         
{a,b,c} {d,e}           
{a,b,c,d}   {e}         
{a} {b} {c,d,e}     
{a} {b,c}   {d,e}       
{a} {b,c,d} {e}     
{a,b}   {c} {d,e}       
{a,b}   {c,d}   {e}     
{a,b,c} {d} {e}     
{a} {b} {c} {d,e}   
{a} {b} {c,d}   {e} 
{a} {b,c}   {d} {e} 
{a,b}   {c} {d} {e} 
{a} {b} {c} {d} {e}

I have tried to use Partitions, SetPartitions, Compositions and Permutations to achieve the same result more elegantly, but without success. Can anyone help, please ?

Simon
  • 1,415
  • 8
  • 13
  • 1
    Your question implies you have a working code, but the code in the question is full of errors, can you please [edit] your question? – rhermans Nov 06 '15 at 16:18
  • My apologies, rhermans. The code seems to work fine for me. I have just added the output. – Simon Nov 06 '15 at 16:19
  • 1
    Does it work for you with a fresh kernel? what are you expecting from Subsets[4]? – rhermans Nov 06 '15 at 16:20
  • Aha ! No ! Perhaps Subsets belongs in the Combinatorica package. I will check now. – Simon Nov 06 '15 at 16:21
  • Im Mma 10.3 I get: Combinatorica Graph and Permutations functionality has been superseded by preloaded functionality. The package now being loaded may conflict with this. Please see the Compatibility Guide for details. Which version are you using? – rhermans Nov 06 '15 at 16:25
  • Yes - that was the problem. Sorry about that. I have edited the code in my question to include loading Combinatorica. Presumably `Subsets has another definition in Combinatorica. I am using version 9 of Mathematica. The code now works for me, even with a fresh kernel. Does the code run for you in v. 10.3, in spite of the warning about Combinatorica ? – Simon Nov 06 '15 at 16:26
  • This is strange, I seem to remember reading in some documentation that Subsets[n] is equivalent to Subsets[Range[n]], but now I cannot find it. In any case, that is exactly how it works for me. – Simon Nov 06 '15 at 16:34
  • 1
    I have edited the code, replacing Subsets[n] by Subsets[Range[n]], so it now no longer depends on the Combinatorica package. – Simon Nov 06 '15 at 16:54
  • 1

3 Answers3

4
Internal`PartitionRagged[{a, b, c, d, e}, #] & /@
         Flatten[Permutations /@ IntegerPartitions[5], 1]

About Internal`PartitionRagged: I have read about it here.

Alexey Golyshev
  • 9,526
  • 2
  • 27
  • 57
3

Possible partitions for a list with 5 elements:

    n = 5;
    Union@Select[Tuples[#, Length@#], Total@# == n &] & /@ 
       IntegerPartitions[n] // Sort // MatrixForm

enter image description here

eldo
  • 67,911
  • 5
  • 60
  • 168
3

Option 1

f[list_] := 
 With[{part = 
    Flatten[Permutations /@ IntegerPartitions[Length[list]], 1]},
  Table[
   First@Last@
     Reap[FoldList[(Sow[First[#]]; Last[#]) &@*TakeDrop, list, p]]
   , {p, part}]
  ]

Mathematica graphics

f[{a, b, c, d, e}] // MatrixForm

Mathematica graphics

Option 2

PartitionRagged[vec_, lens_] := 
 MapThread[vec[[#1 ;; #2]] &, 
  With[{a = Accumulate[lens]}, {a - lens + 1, a}]]

f2[list_] := 
 PartitionRagged[list, #] & /@ 
  Flatten[Permutations /@ IntegerPartitions[Length[list]], 1]
rhermans
  • 36,518
  • 4
  • 57
  • 149
  • 1
    Thank you rhermans. The code is generating errors for me. Syntax::sntxf: "(Sow[First[#]];Last[#])&@" cannot be followed by "*TakeDrop". – Simon Nov 06 '15 at 17:14
  • Did you try with a fresh kernel? What is the error message? – rhermans Nov 06 '15 at 17:16
  • 1
    Yes, I tried with a fresh kernel. The @ is highlighted and the first error message is Syntax::sntxf: "(Sow[First[#]];Last[#])&@" cannot be followed by "*TakeDrop". – Simon Nov 06 '15 at 17:17
  • Strange, try replacing by Composition[(Sow[First[#]]; Last[#]) & , TakeDrop]. The thing is that v9 has a different take on Composition or Compose – rhermans Nov 06 '15 at 17:24
  • Thank you, I will certainly look into this if I get a chance. Meanwhile I'll go with Alexey's answer. Many thanks again for your help. – Simon Nov 07 '15 at 12:16