5
$\begingroup$

Given a list with $n$ elements and an integer $k$ I want to get a list with all possible groupings of these n elements in sets with at most k elements. For example, given $n=\{1,2,3,4\}$ and $k=3$ I want

$$S=\{P_1,P_2,P_3,P_4,P_5,P_6,P_7,P_8,P_9,P_{10},P_{11}\}$$

where

$$P_1=\{\{1\},\{2\},\{3\},\{4\}\}\\ P_2=\{\{1,2\},\{3\},\{4\}\}\\ P_3=\{\{1,3\},\{2\},\{4\}\}\\P_4=\{\{1,4\},\{2\},\{3\}\}\\ P_5=\{\{2,3\},\{1\},\{4\}\}\\P_6=\{\{2,4\},\{1\},\{3\}\}\\ P_7=\{\{3,4\},\{1\},\{2\}\}\\P_8=\{\{1,2\},\{3,4\}\}\\ P_9=\{\{1,3\},\{2,4\}\}\\P_{10}=\{\{1,2,3\},\{4\}\}\\P_{11}=\{\{1,2,4\},\{3\}\}\\P_{12}=\{\{1,3,4\},\{2\}\}\\P_{13}=\{\{2,3,4\},\{1\}\}$$

$\endgroup$
4
  • 1
    $\begingroup$ Do you also already have some code you tried? $\endgroup$
    – Johu
    Sep 24, 2018 at 12:45
  • $\begingroup$ Seems to be a duplicate of this. $\endgroup$ Sep 24, 2018 at 12:48
  • $\begingroup$ @Davi Bastos Hmm. Do I get something wrong or are you missing the partitions into exactly two sets with two elements each? $\endgroup$ Sep 24, 2018 at 13:19
  • $\begingroup$ Johu, I did a code, but using Pyhton... rs J.M I tried to find a similar question but I didn't, but thanks for the link! Henrik Schumacker Yes, I missed them, I should edit and include them, right? Thanks all! :) $\endgroup$ Sep 24, 2018 at 15:18

2 Answers 2

3
$\begingroup$

Adapting the code linked by J.M.:

groupings[n_, k_] := Module[{list, bla, blubb},
   list = Range[n];
   bla = Internal`PartitionRagged[list, #] & /@ IntegerPartitions[n, n, Range[k]];
   blubb = Flatten[PermutationReplace[#, Permutations[list]] & /@ bla, 1];
   DeleteDuplicates[Sort[Sort /@ Map[Sort, blubb, {2}]]]
   ];

groupings[4, 3]

{

{{1}, {2, 3, 4}},

{{2}, {1, 3, 4}},

{{3}, {1, 2, 4}},

{{4}, {1, 2,3}},

{{1, 2}, {3, 4}},

{{1, 3}, {2, 4}},

{{1, 4}, {2, 3}},

{{1}, {2}, {3, 4}},

{{1}, {3}, {2, 4}},

{{1}, {4}, {2, 3}},

{{2}, {3}, {1, 4}},

{{2}, {4}, {1, 3}},

{{3}, {4}, {1, 2}},

{{1}, {2}, {3}, {4}}

}

Alternatively, using "Combinatorica`" (probably more efficient):

Needs["Combinatorica`"];
Select[
 SetPartitions[Range[4]],
 Max[Length /@ #] <= 3 &
 ]
$\endgroup$
3
$\begingroup$

A modification of Finding all partitions of a set, itself based on BellList from Robert M. Dickau

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

partition[{r__, x_}, k_] :=
 Join @@ (
    ReplaceList[
      #,
      {b___, {S : Repeated[_, k - 1]}, a___} | {b__} :> {b, {S, x}, a}
    ] & /@ partition[{r}, k]
 )

partition[{1, 2, 3, 4}, 3]
$\endgroup$

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.