# How to get the complete list of subsets the pairwise intersections of which are empty

Given the list Range[4]. I want to get the sublists of length 2 where each element has length 2 and the pairwise intersections are empty. So I am looking for:

  {{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}


Switched elements like {{1,2},{4,3}} should not appear. My code works well but when Range and lengths get bigger it consumes a lot of space and time. For sublists of length 3 with two elements the result would look like:

    {{{1, 2}, {3, 4}, {5, 6}}, {{1, 2}, {3, 5}, {4, 6}}, {{1, 2}, {3,
6}, {4, 5}}, {{1, 3}, {2, 4}, {5, 6}}, {{1, 3}, {2, 5}, {4,
6}}, {{1, 3}, {2, 6}, {4, 5}}, {{1, 4}, {2, 3}, {5, 6}}, {{1,
4}, {2, 5}, {3, 6}}, {{1, 4}, {2, 6}, {3, 5}}, {{1, 5}, {2, 3}, {4,
6}}, {{1, 5}, {2, 4}, {3, 6}}, {{1, 5}, {2, 6}, {3, 4}}, {{1,
6}, {2, 3}, {4, 5}}, {{1, 6}, {2, 4}, {3, 5}}, {{1, 6}, {2, 5}, {3,
4}}}


Is there a function (maybe in Combinatorica) for this problem or a smarter way to do it? I am sure this is a standard problem and there must be a name for this kind of sublist. I would be grateful for further hints.

Here is my code:

k = 3;
t1 = Partition[#, {2}] & /@ Permutations[Range[2 k]]
t2 = Map[Sort, t1, {2}]
t3 = Map[Sort, t2, {1}]
t4 = DeleteDuplicates[t3]

• "when Range and lengths get bigger..." - how "big" do you need? Also, is this just some exercise, or is there some underlying (combinatorial) problem you're targeting that might be better handled by other means (i.e., might this be an x-y question)?
– ciao
Jun 1, 2021 at 5:49
• Range apx 100, lenghts apx 10. Can you please give some hints how to use "other means". Not sure what you mean by x-y-question. But I'd be happy to learn about general solutions. Jun 1, 2021 at 6:52
• Could it be that for Range[6] for 2 list example your want Flatten[ReplacePart[{#}, 1 -> {{{#[[1]], #[[2]]}, {#[[3]], #[[4]]}}, {{#[[1]], #[[3]]}, {#[[2]], #[[4]]}}, {{#[[1]], #[[4]]}, {#[[2]], #[[3]]}}}] & /@ Subsets[Range[6], {4}], 2] ?
– Acus
Jun 1, 2021 at 7:57
• Sorry! Yes, you are right. It should have said Range[4] for the first example. Jun 1, 2021 at 8:36

## 1 Answer

Avoid generating wrong lists as early as possible. Here is a recursive attempt. It beats your implementation starting from k=5. First define one step recursion transform

recursionStep[x_List, y_List] :=
Flatten[Outer[
If[DuplicateFreeQ[Flatten[{##}]] && OrderedQ[Flatten[{##}, 1]],
Flatten[{##}, 1], Nothing] &, x, y, 1], 1]


Next, apply it as many steps as needed.

 k = 5;

Nest[recursionStep[List /@ Subsets[Range[2*k], {2}], #] &,
List /@ Subsets[Range[2*k], {2}], k - 1] // Length//AbsoluteTiming
(*{0.797619, 945}*)


Yours on my hardware yields {3.92687,945}. The difference will increase for larger k values.