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$ 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.'s discontentment 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, 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 &
 ]
| improve this answer | |
$\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]
| improve this answer | |
$\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.