How to generate all commutative pairings of list elements?
I think the number of such pairings is given by:
pairCounts[n_?EvenQ] := Multinomial @@ ConstantArray[2, n/2]/(n/2)!
So, you will get:
pairCounts[20]
654729075
which is a lot of pairings for a list of length 20. What do you plan to do with this list?
At any rate, here is a not very efficient method:
partitions[{a_,b_}] := {{{a,b}}}
partitions[{a_,b__}] := Catenate@Table[
Prepend[{a, {b}[[i]]}] /@ partitions[Delete[{b}, i]],
{i, Length[{b}]}
]
For example:
partitions[Range[4]]
partitions[Range[6]]
{{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}
{{{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}}}
ClearAll[perfectMatchings]
perfectMatchings = Module[{subs = Subsets[#, {2}], l = Length @ #, matchings},
matchings = FindIndependentVertexSet[LineGraph[UndirectedEdge @@@ subs], l/2, All];
Extract[subs, List /@ matchings] ] &;
perfectMatchings[Range @ 4] // Grid // TeXForm
$\small\begin{array}{cc} \{1,4\} & \{2,3\} \\ \{1,3\} & \{2,4\} \\ \{1,2\} & \{3,4\} \\ \end{array}$
perfectMatchings[Range @ 6] // Grid // TeXForm
$\small\begin{array}{ccc} \{1,6\} & \{2,5\} & \{3,4\} \\ \{1,6\} & \{2,4\} & \{3,5\} \\ \{1,6\} & \{2,3\} & \{4,5\} \\ \{1,5\} & \{2,6\} & \{3,4\} \\ \{1,5\} & \{2,4\} & \{3,6\} \\ \{1,5\} & \{2,3\} & \{4,6\} \\ \{1,4\} & \{2,6\} & \{3,5\} \\ \{1,4\} & \{2,5\} & \{3,6\} \\ \{1,4\} & \{2,3\} & \{5,6\} \\ \{1,3\} & \{2,6\} & \{4,5\} \\ \{1,3\} & \{2,5\} & \{4,6\} \\ \{1,3\} & \{2,4\} & \{5,6\} \\ \{1,2\} & \{3,6\} & \{4,5\} \\ \{1,2\} & \{3,5\} & \{4,6\} \\ \{1,2\} & \{3,4\} & \{5,6\} \\ \end{array}$
Note: This is much slower than Carl's partitions
and Kagaratsch's pairings
.
Here a recursive solution, which I suspect is similar to the one by Carl Woll:
pairings[list_, progress_] := Block[{},
If[Length[list] > 1,
Flatten[
Table[
pairings[Drop[list[[2 ;;]], {i - 1}],
Append[progress, {list[[1]], list[[i]]}]]
, {i, 2, Length[list]}]
, 1]
,
p[progress]
]
]
With outputs
pairings[Range[4], {}]
{p[{{1, 2}, {3, 4}}], p[{{1, 3}, {2, 4}}], p[{{1, 4}, {2, 3}}]}
and
pairings[Range[6], {}]
{p[{{1, 2}, {3, 4}, {5, 6}}], p[{{1, 2}, {3, 5}, {4, 6}}],
p[{{1, 2}, {3, 6}, {4, 5}}], p[{{1, 3}, {2, 4}, {5, 6}}],
p[{{1, 3}, {2, 5}, {4, 6}}], p[{{1, 3}, {2, 6}, {4, 5}}],
p[{{1, 4}, {2, 3}, {5, 6}}], p[{{1, 4}, {2, 5}, {3, 6}}],
p[{{1, 4}, {2, 6}, {3, 5}}], p[{{1, 5}, {2, 3}, {4, 6}}],
p[{{1, 5}, {2, 4}, {3, 6}}], p[{{1, 5}, {2, 6}, {3, 4}}],
p[{{1, 6}, {2, 3}, {4, 5}}], p[{{1, 6}, {2, 4}, {3, 5}}],
p[{{1, 6}, {2, 5}, {3, 4}}]}
Turns out, this one is a bit slower than partitions
by Carl Woll:
pairings[Range[14], {}] // Length // AbsoluteTiming
{1.91637, 135135}
partitions[Range[14]] // Length // AbsoluteTiming
{1.1277, 135135}