3
$\begingroup$

I would like to do the following:

Suppose there is a list {a, b, c, d}. I would like to get all distinct exhaustive combinations of its sublists of a certain length, so for this specific list I would like to get

{ {a, b}{c, d} , {a, c}{b, d} , {a, d}{b, c} }.

Now suppose I have multiple such lists, and I would like to do this operation on each of them. How should we do this?

The result does not have to be a list object of sublists; as long as it is clear how elements are paired anything is fine.

$\endgroup$
  • $\begingroup$ Here's a brute force method: DeleteDuplicates[Sort[#] & /@ Permutations[{a, b, c, d}, {2}]]. $\endgroup$ – JimB Jul 13 '17 at 18:26
  • $\begingroup$ @JimBaldwin This doesn't seem to do what I need. It gives individual sublists of length 2, but I need combinations of such length-2 sublists that cover all elements in the original list without repetition. $\endgroup$ – Rethliopuks Jul 13 '17 at 18:33
4
$\begingroup$

Given that your request for {}{} is non-syntactic, I'll assume that you want lists of such sublists:

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

DeleteDuplicates[
 Map[Sort, 
  Map[Sort, 
   Partition[#, 2] & /@ (Sort[Permutations[mylist]]), {2}], {2}]]
$\endgroup$
  • $\begingroup$ Thanks! This is very close to what I want. Would it be possible to delete duplicate combinations of the same sublists? So for example, keep only one of {{a, c}, {b, d}} and {{b, d}, {a, c}}. $\endgroup$ – Rethliopuks Jul 13 '17 at 19:15
  • 1
    $\begingroup$ Is one of Map[Sort, ..., {2}] intended to have level {1}? You can take care of both levels in one Map call using Map[Sort, ..., 2] $\endgroup$ – jkuczm Jul 13 '17 at 19:54
5
$\begingroup$

I will assume that for a set like $\{1, 2, 3, 4, 5, 6\}$ you want partitions of the form: $$(1, 2)(3, 4)(5, 6), (1, 3)(2, 4)(5, 6), ...$$ In this case, the following semi-brute force method will work:

f[set_]:=With[{sort=Sort@set},
    DeleteCases[
        Subsets[Subsets[set,{2}], {Length[set]/2}],
        x_ /; Sort@Flatten@x =!= sort
    ]
]

For example:

f[{a, b, c, d}]
f[Range[6]]

{{{a, b}, {c, d}}, {{a, c}, {b, d}}, {{a, d}, {b, c}}}

{{{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}}}

$\endgroup$
  • $\begingroup$ Since I know you value performance I think you'll find (3050) interesting. $\endgroup$ – Mr.Wizard Jul 14 '17 at 1:30
2
$\begingroup$

This gives the orderings you need:

next[cur_, rem_, n_] := If[Length[cur] =!= n, next[Join[cur, rem[[#]]], rem[[# + 1 ;;]], n] & /@
                     Position[DisjointQ[cur, #] & /@ rem, True, {1}][[All, 1]], Sow[cur]; 0]

make[n_] := Catenate[With[{subs = Subsets[Range[n], {2}]},
              Table[Reap[next[subs[[i - 1]], subs[[i ;;]], n]][[2, 1]], {i, 2, n}]]]

make[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}}

$\endgroup$
  • $\begingroup$ This doesn't seem to exactly do what I need: it gives individual sublists of length 2, like {a, b}, {c, d}, etc., but I need "products of sublists" like {a, b}{c, d}, {a, c}{b, d}, etc. $\endgroup$ – Rethliopuks Jul 13 '17 at 18:29
  • $\begingroup$ @Rethliopuks Are you lists like {a, b, c, d} always with length 4? $\endgroup$ – Coolwater Jul 13 '17 at 18:33
  • $\begingroup$ Their lengths are always an even number. Currently I am only dealing with length 4 and length 6, though I might be doing length 8 some point in the future. $\endgroup$ – Rethliopuks Jul 13 '17 at 18:34
  • $\begingroup$ In fact the sublists only need to be length 2 -- in other word I need to regroup the original list into pairs and find all possibilities of such grouping. $\endgroup$ – Rethliopuks Jul 13 '17 at 18:53
  • $\begingroup$ The {}{} construct is non-syntactic in Mathematica. Why would you ever want that? And what would you want for {a,b,c,d,e,f}? $\endgroup$ – David G. Stork Jul 13 '17 at 18:53
2
$\begingroup$
list = {a, b, c, d};

Cases[Permutations@list, {x : First@list, b_, c_, d_} /; 
   OrderedQ@{x, b} && OrderedQ@{c, d} :> {{x, b}, {c, d}}]   

{{{a, b}, {c, d}}, {{a, c}, {b, d}}, {{a, d}, {b, c}}}

$\endgroup$

Not the answer you're looking for? Browse other questions tagged or ask your own question.