# List of lists with non-repeating elements

I have the following lists:

l1 = {{a,b},{a,c},{a,d},{a,e},{a,f}};
l2 = {{b,c},{b,d},{b,e},{b,f}};
l3 = {{c,d},{c,e},{c,f}};
l4 = {{d,e},{d,f}};
l5 = {e,f};


I want to create a list of combinations of exactly three of the above sublists, with no repeating elemenst. It should look like:

L = {{{a,b},{c,d},{e,f}},{{a,b},{c,e},{d,f}},...,{{{a,c},{b,d},{e,f}}...};


For example, for four lists $$l$$ with elements {a,b,c,d}, the final list should look like this:

L = {{{a,b},{c,d}},{{a,c},{b,d}},{{a,d},{b,c}}};


For five lists $$l$$, the dimensions should be {15,3,2}, but I want to generalize this for more lists $$l$$. As the dimension of $$L$$ grows as $$n!!$$, I'm trying to write a general code.
Is there an easy way to do this? Thank you!

EDIT

As chyanog pointed out in the comments, this question has been answered here. The following function posted by Rojo gives a general list $$L$$ of dimensions $$\{n!!,\frac{n}{2},l\}$$:

  partitions[list_, l_] := Join @@
Table[
{x, ##} & @@@ partitions[list ~Complement~ x, l],
{x, Subsets[list, {l}, Binomial[Length[list] - 1, l - 1]]}
]

partitions[list_, l_] /; Length[list] === l := {{list}}


, and to get the lists I'm looking for, $$l=2$$.

• Commented Jul 4, 2021 at 12:21

Wasteful but general code that uses the numbers $$1\ldots n$$ instead of variables $$\{a,b,c,\ldots\}$$:

f[n_ /; n >= 2 && EvenQ[n]] :=
Select[Subsets[Subsets[Range[n], {2}], {n/2}],
DuplicateFreeQ@*Flatten]

f[2]
(*    {{{1, 2}}}    *)

f[4]
(*    {{{1, 2}, {3, 4}},
{{1, 3}, {2, 4}},
{{1, 4}, {2, 3}}}    *)

f[6]
(*    {{{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}}}                              *)

Table[Length[f[n]], {n, 2, 12, 2}]
(*    {1, 3, 15, 105, 945, 10395}    *)


This procedure is easily extended to splitting $$n$$ numbers (symbols) into non-overlapping bunches of $$k$$:

f[n_Integer?Positive, k_Integer?Positive] /; Divisible[n, k] :=
Select[Subsets[Subsets[Range[n], {k}], {n/k}],
DuplicateFreeQ@*Flatten]

f[6, 1]
(*    {{{1}, {2}, {3}, {4}, {5}, {6}}}    *)

f[6, 2]
(*    {{{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}}}    *)

f[6, 3]
(*    {{{1, 2, 3}, {4, 5, 6}},
{{1, 2, 4}, {3, 5, 6}},
{{1, 2, 5}, {3, 4, 6}},
{{1, 2, 6}, {3, 4, 5}},
{{1, 3, 4}, {2, 5, 6}},
{{1, 3, 5}, {2, 4, 6}},
{{1, 3, 6}, {2, 4, 5}},
{{1, 4, 5}, {2, 3, 6}},
{{1, 4, 6}, {2, 3, 5}},
{{1, 5, 6}, {2, 3, 4}}}    *)

f[6, 6]
(*    {{{1, 2, 3, 4, 5, 6}}}    *)