# How to generate 3-subsets that satisfy certain conditions without post-filtering?

Edits: In fact it is a set partition problem.

I have a set as follows:

s = {"a", "b", "c", "d", "e", "f"}


I want to divide the set into 2 groups such that each group has exactly $$3$$ elements. We want to generate all solutions. Note that we treat ({"a", "b", "c"}|{"d", "e", "f"}) and ({"d", "e", "f"}|{"a", "b", "c"}) as the same solution.

So first I used the Subsets function to generate all 3-subsets and then filtered for duplicate solutions.

s3 = Subsets[s, {3}]
DeleteDuplicates[s3, Union[#1] == Union[Complement[s, #2]] &]

Out[*]: {{"a", "b", "c"}, {"a", "b", "d"}, {"a", "b", "e"}, {"a", "b",
"f"}, {"a", "c", "d"}, {"a", "c", "e"}, {"a", "c", "f"}, {"a", "d",
"e"}, {"a", "d", "f"}, {"a", "e", "f"}}


But I feel like the solution is a bit inefficient. In fact, we only need half of all 3-subsets. I wonder if we can only keep one representative among same solutions when generating the 3-subsets.

Edits: In fact, the problem can be generalized as follows: Given a list of $$n$$ elements, partition it into $$m$$ groups, and generate all possible solutions. Similarly, same solutions are generated only once.

• I believe that in this very specific case you get the set you are looking for by taking half of the subset in order Subsets provides them: Subsets[s, {Length[s]/2}, Binomial[Length[s], Length[s]/2]/2]. Commented Feb 7, 2023 at 14:00
• You need to sort the list lexicographically as "Subsets" does. Commented Feb 7, 2023 at 14:01
• First /@ Gather[s3, DisjointQ] ?
– Syed
Commented Feb 7, 2023 at 14:13
• Could KSetPartition be of some use?
– Syed
Commented Feb 7, 2023 at 14:43
• Related link: partition-a-set-into-subsets-of-size-k Commented Feb 8, 2023 at 3:07

One way is to place the first element in each of the subsets formed from s-1 of the remaining elements, find complements, and recursively subdivvy those complements.

subsetSubsets[set_, s_ /; s <= 0] := {}
subsetSubsets[set_, s_] /; s > Length[set] := {set}
subsetSubsets[set_, s_Integer] := Module[
{first, rest, subsets, firstsets, complements},
subsets = Subsets[Rest[set], {s - 1}];
firstsets = Map[Append[#, First[set]] &, subsets];
complements = Map[Complement[set, #] &, firstsets];
Flatten[Table[
Map[Prepend[#, firstsets[[j]]] &,
subsetSubsets[complements[[j]], s]]
, {j, Length[firstsets]}], 1]
]


Examples:

subsetSubsets[Range[6], 3]

(* Out[41]= {{{2, 3, 1}, {5, 6, 4}}, {{2, 4, 1}, {5, 6, 3}}, {{2, 5,
1}, {4, 6, 3}}, {{2, 6, 1}, {4, 5, 3}}, {{3, 4, 1}, {5, 6,
2}}, {{3, 5, 1}, {4, 6, 2}}, {{3, 6, 1}, {4, 5, 2}}, {{4, 5,
1}, {3, 6, 2}}, {{4, 6, 1}, {3, 5, 2}}, {{5, 6, 1}, {3, 4, 2}}} *)

subsetSubsets[Range[6], 2]

(* Out[42]= {{{2, 1}, {4, 3}, {6, 5}}, {{2, 1}, {5, 3}, {6, 4}}, {{2,
1}, {6, 3}, {5, 4}}, {{3, 1}, {4, 2}, {6, 5}}, {{3, 1}, {5, 2}, {6,
4}}, {{3, 1}, {6, 2}, {5, 4}}, {{4, 1}, {3, 2}, {6, 5}}, {{4,
1}, {5, 2}, {6, 3}}, {{4, 1}, {6, 2}, {5, 3}}, {{5, 1}, {3, 2}, {6,
4}}, {{5, 1}, {4, 2}, {6, 3}}, {{5, 1}, {6, 2}, {4, 3}}, {{6,
1}, {3, 2}, {5, 4}}, {{6, 1}, {4, 2}, {5, 3}}, {{6, 1}, {5, 2}, {4,
3}}} *)