16
$\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]}]
Improve this question
$\endgroup$
4
  • $\begingroup$ Are you not interested in {{a},{b,c,d,e,f}} and similar as well ? $\endgroup$
    – b.gates.you.know.what
    Jul 20, 2012 at 10:25
  • $\begingroup$ Does the Combinatorica function SetPartitions[] not do what you want? $\endgroup$
    – J. M.'s eventual burnout ♦
    Jul 20, 2012 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, 2012 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, 2012 at 10:38

2 Answers 2

Reset to default
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.

Improve this answer
$\endgroup$
4
  • 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.'s eventual burnout ♦
    Jul 20, 2012 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, 2012 at 10:54
  • $\begingroup$ @J.M. +1 thanks for showing the multiple cases $\endgroup$
    – Ali Hashmi
    Apr 22, 2017 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, 2017 at 15:51
12
$\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:

Improve this answer
$\endgroup$
8
  • 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, 2012 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, 2012 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, 2012 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, 2012 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, 2019 at 7:31

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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