Faster solution to combinatorial problem of two-part contractions

Given a list of elements I need all possible pairings of elements with a leading factor that describes the number of permutations. A (ugly but) working version would be:

list = {a, b, c, d};
res = DeleteDuplicates[
Map[Sort, Map[Partition[#, 2] &, Permutations[list]], 2]]
factor = Map[Signature, Map[Flatten, res]]


that gives the desired

res = {{{a, b}, {c, d}}, {{a, c}, {b, d}}, {{a, d}, {b, c}}}


with factors of

factor = {1, -1, 1}.


As this solution scales catastrophically for larger lists, I am looking for ways to speed computation up.

1 Answer

in a 13/05/1997 email, Will Self (wself@viking.emcmt.edu) sent me the following fast code for a more general version of this nice problem:
(* needs Combinatorica *)

groupings[ensemble_, {k_}] := List /@ KSubsets[ensemble, k];
groupings[ensemble_, {1, sequ__}] := Flatten[Table[
Prepend[#, {ensemble[[j]]}] & /@
groupings[Drop[ensemble, {j}], {sequ}], {j, 1, Length[ensemble],
1}], 1];
groupings[ensemble_, {k_, sequ__}] :=
(ReplacePart[#, Prepend[#[[1]], ensemble[[1]]], 1]) & /@
groupings[Drop[ensemble, 1], {k - 1, sequ}];


Using this, your problem reduces to

groupings[{1, 2, 3, 4, 5, 6}, {2, 2, 2}]


and it's speed can be demonstrated by

Table[ Timing[Length@groupings[Range[2 n], Table[2, {n}]]], {n,
7}] // Timing

{5.94364, {{0., 1}, {0., 3}, {0., 15}, {0., 105}, {0.0312002,
945}, {0.374402, 10395}, {5.53804, 135135}}}


Alas, the combinatorial explosion is still there : n=8 takes 94 sec. See http://oeis.org/A001147 for more details.