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$ Commented Sep 24, 2018 at 12:45
  • $\begingroup$ Seems to be a duplicate of this. $\endgroup$ Commented 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$ Commented 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$ Commented 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$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.