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\}\}$$

Improve this question
$\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$
    – J. M.'s eventual burnout ♦
    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$
    – Henrik Schumacher
    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$
    – Davi Bastos
    Sep 24, 2018 at 15:18

2 Answers 2

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