4
$\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$
  • 1
    $\begingroup$ Welcome to Mathematica.SE! Good job formatting your question nicely! Do you also already have some code you tried? $\endgroup$ – Johu Sep 24 '18 at 12:45
  • $\begingroup$ Seems to be a duplicate of this. $\endgroup$ – J. M. will be back soon Sep 24 '18 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$ – Henrik Schumacher Sep 24 '18 at 13:19
  • $\begingroup$ Johu, tanks for the "greetings"! 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$ – Davi Bastos Sep 24 '18 at 15:18
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.