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}