Groupings of the Elements of a List with at Most $k$ Elements

Question

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

Answer 1

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 &
 ]

Answer 2

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]