13
$\begingroup$

I'm looking for straightforward way to find all the partitions of a set.

IntegerPartitions seems to provide a useful start. But then things get a bit complicated.

Imagine we want to find all the ways to partition a list:

myList={a,b,c,d,e,f}

IntegerPartitions gives the some breakdowns, by numbers of elements in each subset.

breakdowns=IntegerPartitions[Length[myList]]

{{6},{5,1},{4,2},{4,1,1},{3,3},{3,2,1},{3,1,1,1},{2,2,2},{2,2,1,1},{2,1,1,1,1},{1,1,1,1,1,1}}

The following function, g, takes the list and the breakdowns, outputting some useful results (but clearly not all possible results).

g[{},_,out_]:=out
g[in_,breaks_,out_]:=g[Drop[in,First@breaks],Rest@breaks,Append[out,Take[in,First@breaks]]]

So

g[myList,#,{}]&/@IntegerPartitions[Length[myList]]//MatrixForm

matrix output


I suspect that there may be some better alternatives to g. Perhaps even a straightforward list-manipulation command.


BTW, we would need to use all permutations of myList to ensure we have all the partitions. Permutations[myList] would be instrumental for that:

Table[g[k,#,{}]&/@IntegerPartitions[Length[myList]],{k,Permutations[myList]}]
$\endgroup$
  • $\begingroup$ Are you not interested in {{a},{b,c,d,e,f}} and similar as well ? $\endgroup$ – b.gates.you.know.what Jul 20 '12 at 10:25
  • $\begingroup$ Does the Combinatorica function SetPartitions[] not do what you want? $\endgroup$ – J. M. will be back soon Jul 20 '12 at 10:28
  • $\begingroup$ Yes, it does! I was not aware of it (or had forgotten about it). Strange that such a basic command is not an integral part of Mathematica's kernel. Would you like to exemplify how it works? (I just tried it successfully, but since you made the suggestion...) $\endgroup$ – DavidC Jul 20 '12 at 10:37
  • $\begingroup$ @b.gatessucks Yes, for sure. That's why I included the note about Permutations at the bottom. $\endgroup$ – DavidC Jul 20 '12 at 10:38
14
$\begingroup$

Starting with myList = {a, b, c, d, e, f}, here are a few solutions, in increasing order of generality:

1.

Internal`PartitionRagged[myList, #] & /@ IntegerPartitions[Length[myList]]
{{{a, b, c, d, e, f}}, {{a, b, c, d, e}, {f}}, {{a, b, c, d}, {e, f}},
 {{a, b, c, d}, {e}, {f}}, {{a, b, c}, {d, e, f}}, {{a, b, c}, {d, e}, {f}},
 {{a, b, c}, {d}, {e}, {f}}, {{a, b}, {c, d}, {e, f}},
 {{a, b}, {c, d}, {e}, {f}}, {{a, b}, {c}, {d}, {e}, {f}},
 {{a}, {b}, {c}, {d}, {e}, {f}}}

2.

Internal`PartitionRagged[myList, #] & /@ 
        Apply[Join, Permutations /@ IntegerPartitions[Length[myList]]]
{{{a, b, c, d, e, f}}, {{a, b, c, d, e}, {f}}, {{a}, {b, c, d, e, f}},
 {{a, b, c, d}, {e, f}}, {{a, b}, {c, d, e, f}}, {{a, b, c, d}, {e}, {f}},
 {{a}, {b, c, d, e}, {f}}, {{a}, {b}, {c, d, e, f}}, {{a, b, c}, {d, e, f}},
 {{a, b, c}, {d, e}, {f}}, {{a, b, c}, {d}, {e, f}}, {{a, b}, {c, d, e}, {f}},
 {{a, b}, {c}, {d, e, f}}, {{a}, {b, c, d}, {e, f}}, {{a}, {b, c}, {d, e, f}},
 {{a, b, c}, {d}, {e}, {f}}, {{a}, {b, c, d}, {e}, {f}}, {{a}, {b}, {c, d, e}, {f}},
 {{a}, {b}, {c}, {d, e, f}}, {{a, b}, {c, d}, {e, f}},
 {{a, b}, {c, d}, {e}, {f}}, {{a, b}, {c}, {d, e}, {f}},
 {{a, b}, {c}, {d}, {e, f}}, {{a}, {b, c}, {d, e}, {f}},
 {{a}, {b, c}, {d}, {e, f}}, {{a}, {b}, {c, d}, {e, f}},
 {{a, b}, {c}, {d}, {e}, {f}}, {{a}, {b, c}, {d}, {e}, {f}},
 {{a}, {b}, {c, d}, {e}, {f}}, {{a}, {b}, {c}, {d, e}, {f}},
 {{a}, {b}, {c}, {d}, {e, f}}, {{a}, {b}, {c}, {d}, {e}, {f}}}

3.

Needs["Combinatorica`"];
Short[SetPartitions[myList], 5]
{{{a, b, c, d, e, f}}, {{a}, {b, c, d, e, f}}, {{a, b}, {c, d, e, f}},
 {{a, c, d, e, f}, {b}}, {{a, b, c}, {d, e, f}}, {{a, d, e, f}, {b, c}},
 {{a, b, d, e, f}, {c}}, {{a, c}, {b, d, e, f}}, {{a, b, c, d}, {e, f}},
 {{a, e, f}, {b, c, d}}, <<184>>, {{a}, {b, d}, {c}, {e}, {f}},
 {{a}, {b, e}, {c}, {d}, {f}}, {{a}, {b, f}, {c}, {d}, {e}},
 {{a, b}, {c}, {d}, {e}, {f}}, {{a, c}, {b}, {d}, {e}, {f}},
 {{a, d}, {b}, {c}, {e}, {f}}, {{a, e}, {b}, {c}, {d}, {f}},
 {{a, f}, {b}, {c}, {d}, {e}}, {{a}, {b}, {c}, {d}, {e}, {f}}}

The output of SetPartitions[] was rather long, so I had to use Short[]. Execute SetPartitions[myList] if you want to see everything.

$\endgroup$
  • 2
    $\begingroup$ As a way of checking the output of SetPartitions[], the following should be True: Length[SetPartitions[myList]] == BellB[Length[myList]]. $\endgroup$ – J. M. will be back soon Jul 20 '12 at 10:49
  • $\begingroup$ Very nice. Your second solution highlights some additional permutations that I had overlooked. And of course, the third solution is, as you note, the most general. $\endgroup$ – DavidC Jul 20 '12 at 10:54
  • $\begingroup$ @J.M. +1 thanks for showing the multiple cases $\endgroup$ – Ali Hashmi Apr 22 '17 at 20:40
  • 1
    $\begingroup$ #2 can now be done quite conveniently without any Internal functions, by using IntegerPartitions and TakeList: tio.run/##LY2xCsJAEER7v2JAsFq4LxCuVVJcYScWa7Imi9wGLptCxG@/… $\endgroup$ – Martin Ender Dec 7 '17 at 15:51
10
$\begingroup$

Based on BellList from Robert M. Dickau:

partition[{x_}] := {{{x}}}

partition[{r__, x_}] :=
  Join @@ (ReplaceList[#,
      {{b___, {S__}, a___} :> {b, {S, x}, a},
       {S__} :> {S, {x}}}
      ] & /@ partition[{r}])

This is faster than SetPartitions on shorter sets:

Needs["Combinatorica`"];
myList = {a, b, c, d, e, f};

partition[myList] ~Do~ {500} // Timing // First
SetPartitions[myList] ~Do~ {500} // Timing // First

0.405

0.843

Related:

$\endgroup$
  • 3
    $\begingroup$ Note to self: read Mr. Wizard's answer more carefully before attempting the problem! Just spent 10 minutes coming up with essentially the same code. Except I used the Alternatives thing you showed me to express the replacement in a single rule: ReplaceList[#,{b___,{S__},a___}|{b__}:>{b,{S, x},a}] $\endgroup$ – Simon Woods Jul 21 '12 at 13:28
  • 1
    $\begingroup$ @Simon I love it! You're schooling me with my own tricks! This was a copy&paste job from old code but I wish I'd seen that myself. Honestly it thrills me that you're open to methods like this as I sometimes feel that nobody is listening. I say again, it's good to have you aboard. (FWIW it appears that | is slightly slower in this application, something I have observed before and you may want to be aware of. It's probably because of the extraneous "Sequence" operations that are performed. Still for me the form you show is beautiful.) $\endgroup$ – Mr.Wizard Jul 21 '12 at 22:46
  • $\begingroup$ thank you! It's good to be aboard - I've learnt so much in just three months from this community. I'm particularly open to learning new methods with pattern matching, it's such a powerful aspect of the language and I'm only just starting to appreciate how flexible it is. $\endgroup$ – Simon Woods Jul 22 '12 at 11:29
  • $\begingroup$ Mr. Wizard. This is replacement as its best. Wow! The problem with SetPartitions in Combinatorica is the workhorse function KSetPartitions. Inside there is a lot of copying going on. On the other hand, although your approach is very fast, the implementation in KSetPartitions relies more on the algorithm itself. Yours is fascinating syntax wizardry. $\endgroup$ – Stefan Dec 19 '12 at 15:38
  • 1
    $\begingroup$ @Alexander It is a two part definition; you must evaluate partition[{x_}] := {{{x}}} as well as the larger one; without that you'll get the incorrect output you show—with it you'll get {{{1, 2, 3, 4}}, {{1, 2, 3}, {4}}, {{1, 2, 4}, {3}}, {{1, 2}, {3, 4}}, {{1, 2}, {3}, {4}}, {{1, 3, 4}, {2}}, {{1, 3}, {2, 4}}, {{1, 3}, {2}, {4}}, {{1, 4}, {2, 3}}, {{1}, {2, 3, 4}}, {{1}, {2, 3}, {4}}, {{1, 4}, {2}, {3}}, {{1}, {2, 4}, {3}}, {{1}, {2}, {3, 4}}, {{1}, {2}, {3}, {4}}} $\endgroup$ – Mr.Wizard Jun 19 at 7:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.