3
$\begingroup$

Given the list Range[4]. I want to get the sublists of length 2 where each element has length 2 and the pairwise intersections are empty. So I am looking for:

  {{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}

Switched elements like {{1,2},{4,3}} should not appear. My code works well but when Range and lengths get bigger it consumes a lot of space and time. For sublists of length 3 with two elements the result would look like:

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

Is there a function (maybe in Combinatorica) for this problem or a smarter way to do it? I am sure this is a standard problem and there must be a name for this kind of sublist. I would be grateful for further hints.

Here is my code:

k = 3;
t1 = Partition[#, {2}] & /@ Permutations[Range[2 k]]
t2 = Map[Sort, t1, {2}]
t3 = Map[Sort, t2, {1}]
t4 = DeleteDuplicates[t3]
$\endgroup$
4
  • $\begingroup$ "when Range and lengths get bigger..." - how "big" do you need? Also, is this just some exercise, or is there some underlying (combinatorial) problem you're targeting that might be better handled by other means (i.e., might this be an x-y question)? $\endgroup$
    – ciao
    Jun 1, 2021 at 5:49
  • $\begingroup$ Range apx 100, lenghts apx 10. Can you please give some hints how to use "other means". Not sure what you mean by x-y-question. But I'd be happy to learn about general solutions. $\endgroup$
    – user57467
    Jun 1, 2021 at 6:52
  • $\begingroup$ Could it be that for Range[6] for 2 list example your want Flatten[ReplacePart[{#}, 1 -> {{{#[[1]], #[[2]]}, {#[[3]], #[[4]]}}, {{#[[1]], #[[3]]}, {#[[2]], #[[4]]}}, {{#[[1]], #[[4]]}, {#[[2]], #[[3]]}}}] & /@ Subsets[Range[6], {4}], 2] ? $\endgroup$
    – Acus
    Jun 1, 2021 at 7:57
  • $\begingroup$ Sorry! Yes, you are right. It should have said Range[4] for the first example. $\endgroup$
    – user57467
    Jun 1, 2021 at 8:36

1 Answer 1

5
$\begingroup$

Avoid generating wrong lists as early as possible. Here is a recursive attempt. It beats your implementation starting from k=5. First define one step recursion transform

recursionStep[x_List, y_List] := 
 Flatten[Outer[
   If[DuplicateFreeQ[Flatten[{##}]] && OrderedQ[Flatten[{##}, 1]], 
     Flatten[{##}, 1], Nothing] &, x, y, 1], 1]

Next, apply it as many steps as needed.

 k = 5;
    
    Nest[recursionStep[List /@ Subsets[Range[2*k], {2}], #] &, 
      List /@ Subsets[Range[2*k], {2}], k - 1] // Length//AbsoluteTiming
(*{0.797619, 945}*)

Yours on my hardware yields {3.92687,945}. The difference will increase for larger k values.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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