Permutations with subsets not containing the same elements

Question

I would like to define a function of two integer variables $ \{n, k\} $, with $ k | n $, that would print all the possible permutations of the first $ n$ positive integers, such that the subsets of $ k $ elements never contains $ 2 $ times the same elements of the previous permutations. As an example, this should be the output with $ n = 20, k = 4 $:

$\{1, 2, 3, 4\}$, $\{5, 6, 7, 8\}$, $\{9, 10, 11, 12\}$, $\{13, 14, 15, 16\}$, $\{17, 18, 19, 20\}$

$\{1, 5, 9, 13\}$, $\{17, 2, 6, 10\}$, $\{14, 18, 3, 7\}$, $\{11, 15, 19, 4\}$, $\{8, 12, 16, 20\}$

$\{1, 17, 14, 8\}$, $\{5,2,12,15\}$, $\{9, 16, 3, 19\}$, $\{20, 10, 7, 4\}$, $\{11, 18, 6, 13\}$

$ ...$

Could you give example with much smaller {,} and its complete output you expect. Like {3,2} or {4,3}. — Vitaliy Kaurov, Feb 13 '23 at 08:54
@VitaliyKaurov Ok, let's say it's $ [4,2] $ (because $ k | n $), so the output would be:
${1, 2}$, ${3, 4}$
${1, 3}$, ${2, 4}$
${1, 4}$, ${2, 3}$

With the slash intended as new line — user967210, Feb 13 '23 at 11:36

score 1 · Answer 1 · answered Feb 15 '23 at 21:10

We may first create all k subsets of 1..n;

Then we need to select n/k subsets that have no common elements. Toward this aim we define a function that, given a number of subsets, selects a further subset that has no common element. It repeats this recursively until n/k subsets. We then feed the first subset to our routine, then the second e.t.c until we fed all subsets starting with 1. Finally we join all results.

main[n_, k_] := Module[{d = Range[n], p, step},
If[! Divisible[n, k], Print["n not divisible by k."]; Return[]];
  p = Subsets[d, {k}];
step[e1_] := Module[{es = Flatten[e1], new, res,fun},
    fun[e_] := ( 
      new = Select[p, (! IntersectingQ[Flatten[{e}], #]) &];
      Append[e, #] & /@ new);
res = Flatten[fun /@ e1, 1];
If[Length[res[[1]]] == n/k, res, step[res]]
];


Join @@ Reap[
     Do[
      Sow[step[{{p[[1]]}}]];
      p = Rest[p];
      , Binomial[n - 1, k - 1]]][[2, 1]] 
  ]

Now for a test:

main[4, 2]
{{{1, 2}, {3, 4}}, {{1, 3}, {2, 4}}, {{1, 4}, {2, 3}}}

Or:

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

Or:

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

Thanks for your answer. But the function you defined show all the possible combinations, now I need to sort out just the ones where the subsets doesn't contain two elements that were presents in the previous subsets configurations. E.g. with $ main[6,3] $, I would just expect ${$ ${1, 2, 3}$, ${4, 5, 6}$ $}$, because it's not possible to find other subsets with $ 3 $ elements not containing $ 2 $ elements that were already present in one of the two starting subsets. I hope I explained my request. Thank you — user967210, Feb 15 '23 at 22:27
I found out that sometimes the answer is redundant, I mean with $main[6,2]$ the output contains $2$ times {{1, 2}, {4, 6}, {3, 5}} and all the other sublists (they should be 15 and not 30) — user967210, Feb 17 '23 at 07:22
I can not verify this, I get 30 lists. Try with a fresh kernel. — Daniel Huber, Feb 17 '23 at 08:32
Yep but among them you get ...{{1, 2}, {3, 5}, {4, 6}}, {{1, 2}, {4, 6}, {3, 5}}..., which is basically the same. Don't worry, I same what fixed that — user967210, Feb 17 '23 at 08:40

user42582 · Answer 2 · 2023-02-20T08:31:38.820

I define permutationsNk[n,k] for Integer arguments, where k divides into n (or, alternatively, where k belongs to the Divisors of n).

Evaluating eg. res=permutationsNk[4,2] returns

Looking inside the Iconized object, one finds

res // First

Following along, down the depth of the result, one finds that the first iconized sub-element (of the top-level result) evaluates to

res // First/*(Part[#, 1] &)/*First

which can be further shown to be

res // First/*(Part[#, 1] &)/*First/*(Part[#, 1] &)/*First

Similarly, the second and third iconized sub-elements of the top-level result evaluate to

and respectively.

It might have been easier or more convenient to evaluate the result all at once, using something like

res // First/*Map[First/*Map[First]]/*Apply[Join]

however, the results for the general case ($n$ and $k$ integers and $k|n$) can be too many in number and an approach like the one above, might temporarily freeze or hang the notebook.

It's not to say that accessing the results in a piecemeal fashion, is a definite workaround for the problem of the combinatorial explosion in the number of the results, however it seems to help, for reasonable input arguments (however, I haven't tried anything above $n=20$, so I could be wrong for even moderate values of $n$, but I'm confident that it's not the case).

Just to provide another example, evaluating res=permutationsNk[8,4] and using the bulk way (the one-liner presented above) to access the results (again, which might cause trouble with larger values for $n$) returns

Before providing the code, I will produce another example for the case permutations[12,6], only this time the result is provided in plain text format and can be used for testing purposes:

permutations[12,6]

evaluates to

{{{1,2,3,4,5,6},{2,3,4,5,6,7},{3,4,5,6,7,8},{4,5,6,7,8,9},{5,6,7,8,9,10},{6,7,8,9,10,11},{7,8,9,10,11,12}},{{1,2,3,4,5,7},{2,3,4,5,6,8},{3,4,5,6,7,9},{4,5,6,7,8,10},{5,6,7,8,9,11},{6,7,8,9,10,12}},{{1,2,3,4,6,7},{2,3,4,5,7,8},{3,4,5,6,8,9},{4,5,6,7,9,10},{5,6,7,8,10,11},{6,7,8,9,11,12}},{{1,2,3,5,6,7},{2,3,4,6,7,8},{3,4,5,7,8,9},{4,5,6,8,9,10},{5,6,7,9,10,11},{6,7,8,10,11,12}},{{1,2,4,5,6,7},{2,3,5,6,7,8},{3,4,6,7,8,9},{4,5,7,8,9,10},{5,6,8,9,10,11},{6,7,9,10,11,12}},{{1,3,4,5,6,7},{2,4,5,6,7,8},{3,5,6,7,8,9},{4,6,7,8,9,10},{5,7,8,9,10,11},{6,8,9,10,11,12}},{{1,2,3,4,5,8},{2,3,4,5,6,9},{3,4,5,6,7,10},{4,5,6,7,8,11},{5,6,7,8,9,12}},{{1,2,3,4,6,8},{2,3,4,5,7,9},{3,4,5,6,8,10},{4,5,6,7,9,11},{5,6,7,8,10,12}},{{1,2,3,4,7,8},{2,3,4,5,8,9},{3,4,5,6,9,10},{4,5,6,7,10,11},{5,6,7,8,11,12}},{{1,2,3,5,6,8},{2,3,4,6,7,9},{3,4,5,7,8,10},{4,5,6,8,9,11},{5,6,7,9,10,12}},{{1,2,3,5,7,8},{2,3,4,6,8,9},{3,4,5,7,9,10},{4,5,6,8,10,11},{5,6,7,9,11,12}},{{1,2,3,6,7,8},{2,3,4,7,8,9},{3,4,5,8,9,10},{4,5,6,9,10,11},{5,6,7,10,11,12}},{{1,2,4,5,6,8},{2,3,5,6,7,9},{3,4,6,7,8,10},{4,5,7,8,9,11},{5,6,8,9,10,12}},{{1,2,4,5,7,8},{2,3,5,6,8,9},{3,4,6,7,9,10},{4,5,7,8,10,11},{5,6,8,9,11,12}},{{1,2,4,6,7,8},{2,3,5,7,8,9},{3,4,6,8,9,10},{4,5,7,9,10,11},{5,6,8,10,11,12}},{{1,2,5,6,7,8},{2,3,6,7,8,9},{3,4,7,8,9,10},{4,5,8,9,10,11},{5,6,9,10,11,12}},{{1,3,4,5,6,8},{2,4,5,6,7,9},{3,5,6,7,8,10},{4,6,7,8,9,11},{5,7,8,9,10,12}},{{1,3,4,5,7,8},{2,4,5,6,8,9},{3,5,6,7,9,10},{4,6,7,8,10,11},{5,7,8,9,11,12}},{{1,3,4,6,7,8},{2,4,5,7,8,9},{3,5,6,8,9,10},{4,6,7,9,10,11},{5,7,8,10,11,12}},{{1,3,5,6,7,8},{2,4,6,7,8,9},{3,5,7,8,9,10},{4,6,8,9,10,11},{5,7,9,10,11,12}},{{1,4,5,6,7,8},{2,5,6,7,8,9},{3,6,7,8,9,10},{4,7,8,9,10,11},{5,8,9,10,11,12}},{{1,2,3,4,5,9},{2,3,4,5,6,10},{3,4,5,6,7,11},{4,5,6,7,8,12}},{{1,2,3,4,6,9},{2,3,4,5,7,10},{3,4,5,6,8,11},{4,5,6,7,9,12}},{{1,2,3,4,7,9},{2,3,4,5,8,10},{3,4,5,6,9,11},{4,5,6,7,10,12}},{{1,2,3,4,8,9},{2,3,4,5,9,10},{3,4,5,6,10,11},{4,5,6,7,11,12}},{{1,2,3,5,6,9},{2,3,4,6,7,10},{3,4,5,7,8,11},{4,5,6,8,9,12}},{{1,2,3,5,7,9},{2,3,4,6,8,10},{3,4,5,7,9,11},{4,5,6,8,10,12}},{{1,2,3,5,8,9},{2,3,4,6,9,10},{3,4,5,7,10,11},{4,5,6,8,11,12}},{{1,2,3,6,7,9},{2,3,4,7,8,10},{3,4,5,8,9,11},{4,5,6,9,10,12}},{{1,2,3,6,8,9},{2,3,4,7,9,10},{3,4,5,8,10,11},{4,5,6,9,11,12}},{{1,2,3,7,8,9},{2,3,4,8,9,10},{3,4,5,9,10,11},{4,5,6,10,11,12}},{{1,2,4,5,6,9},{2,3,5,6,7,10},{3,4,6,7,8,11},{4,5,7,8,9,12}},{{1,2,4,5,7,9},{2,3,5,6,8,10},{3,4,6,7,9,11},{4,5,7,8,10,12}},{{1,2,4,5,8,9},{2,3,5,6,9,10},{3,4,6,7,10,11},{4,5,7,8,11,12}},{{1,2,4,6,7,9},{2,3,5,7,8,10},{3,4,6,8,9,11},{4,5,7,9,10,12}},{{1,2,4,6,8,9},{2,3,5,7,9,10},{3,4,6,8,10,11},{4,5,7,9,11,12}},{{1,2,4,7,8,9},{2,3,5,8,9,10},{3,4,6,9,10,11},{4,5,7,10,11,12}},{{1,2,5,6,7,9},{2,3,6,7,8,10},{3,4,7,8,9,11},{4,5,8,9,10,12}},{{1,2,5,6,8,9},{2,3,6,7,9,10},{3,4,7,8,10,11},{4,5,8,9,11,12}},{{1,2,5,7,8,9},{2,3,6,8,9,10},{3,4,7,9,10,11},{4,5,8,10,11,12}},{{1,2,6,7,8,9},{2,3,7,8,9,10},{3,4,8,9,10,11},{4,5,9,10,11,12}},{{1,3,4,5,6,9},{2,4,5,6,7,10},{3,5,6,7,8,11},{4,6,7,8,9,12}},{{1,3,4,5,7,9},{2,4,5,6,8,10},{3,5,6,7,9,11},{4,6,7,8,10,12}},{{1,3,4,5,8,9},{2,4,5,6,9,10},{3,5,6,7,10,11},{4,6,7,8,11,12}},{{1,3,4,6,7,9},{2,4,5,7,8,10},{3,5,6,8,9,11},{4,6,7,9,10,12}},{{1,3,4,6,8,9},{2,4,5,7,9,10},{3,5,6,8,10,11},{4,6,7,9,11,12}},{{1,3,4,7,8,9},{2,4,5,8,9,10},{3,5,6,9,10,11},{4,6,7,10,11,12}},{{1,3,5,6,7,9},{2,4,6,7,8,10},{3,5,7,8,9,11},{4,6,8,9,10,12}},{{1,3,5,6,8,9},{2,4,6,7,9,10},{3,5,7,8,10,11},{4,6,8,9,11,12}},{{1,3,5,7,8,9},{2,4,6,8,9,10},{3,5,7,9,10,11},{4,6,8,10,11,12}},{{1,3,6,7,8,9},{2,4,7,8,9,10},{3,5,8,9,10,11},{4,6,9,10,11,12}},{{1,4,5,6,7,9},{2,5,6,7,8,10},{3,6,7,8,9,11},{4,7,8,9,10,12}},{{1,4,5,6,8,9},{2,5,6,7,9,10},{3,6,7,8,10,11},{4,7,8,9,11,12}},{{1,4,5,7,8,9},{2,5,6,8,9,10},{3,6,7,9,10,11},{4,7,8,10,11,12}},{{1,4,6,7,8,9},{2,5,7,8,9,10},{3,6,8,9,10,11},{4,7,9,10,11,12}},{{1,5,6,7,8,9},{2,6,7,8,9,10},{3,7,8,9,10,11},{4,8,9,10,11,12}},{{1,2,3,4,5,10},{2,3,4,5,6,11},{3,4,5,6,7,12}},{{1,2,3,4,6,10},{2,3,4,5,7,11},{3,4,5,6,8,12}},{{1,2,3,4,7,10},{2,3,4,5,8,11},{3,4,5,6,9,12}},{{1,2,3,4,8,10},{2,3,4,5,9,11},{3,4,5,6,10,12}},{{1,2,3,4,9,10},{2,3,4,5,10,11},{3,4,5,6,11,12}},{{1,2,3,5,6,10},{2,3,4,6,7,11},{3,4,5,7,8,12}},{{1,2,3,5,7,10},{2,3,4,6,8,11},{3,4,5,7,9,12}},{{1,2,3,5,8,10},{2,3,4,6,9,11},{3,4,5,7,10,12}},{{1,2,3,5,9,10},{2,3,4,6,10,11},{3,4,5,7,11,12}},{{1,2,3,6,7,10},{2,3,4,7,8,11},{3,4,5,8,9,12}},{{1,2,3,6,8,10},{2,3,4,7,9,11},{3,4,5,8,10,12}},{{1,2,3,6,9,10},{2,3,4,7,10,11},{3,4,5,8,11,12}},{{1,2,3,7,8,10},{2,3,4,8,9,11},{3,4,5,9,10,12}},{{1,2,3,7,9,10},{2,3,4,8,10,11},{3,4,5,9,11,12}},{{1,2,3,8,9,10},{2,3,4,9,10,11},{3,4,5,10,11,12}},{{1,2,4,5,6,10},{2,3,5,6,7,11},{3,4,6,7,8,12}},{{1,2,4,5,7,10},{2,3,5,6,8,11},{3,4,6,7,9,12}},{{1,2,4,5,8,10},{2,3,5,6,9,11},{3,4,6,7,10,12}},{{1,2,4,5,9,10},{2,3,5,6,10,11},{3,4,6,7,11,12}},{{1,2,4,6,7,10},{2,3,5,7,8,11},{3,4,6,8,9,12}},{{1,2,4,6,8,10},{2,3,5,7,9,11},{3,4,6,8,10,12}},{{1,2,4,6,9,10},{2,3,5,7,10,11},{3,4,6,8,11,12}},{{1,2,4,7,8,10},{2,3,5,8,9,11},{3,4,6,9,10,12}},{{1,2,4,7,9,10},{2,3,5,8,10,11},{3,4,6,9,11,12}},{{1,2,4,8,9,10},{2,3,5,9,10,11},{3,4,6,10,11,12}},{{1,2,5,6,7,10},{2,3,6,7,8,11},{3,4,7,8,9,12}},{{1,2,5,6,8,10},{2,3,6,7,9,11},{3,4,7,8,10,12}},{{1,2,5,6,9,10},{2,3,6,7,10,11},{3,4,7,8,11,12}},{{1,2,5,7,8,10},{2,3,6,8,9,11},{3,4,7,9,10,12}},{{1,2,5,7,9,10},{2,3,6,8,10,11},{3,4,7,9,11,12}},{{1,2,5,8,9,10},{2,3,6,9,10,11},{3,4,7,10,11,12}},{{1,2,6,7,8,10},{2,3,7,8,9,11},{3,4,8,9,10,12}},{{1,2,6,7,9,10},{2,3,7,8,10,11},{3,4,8,9,11,12}},{{1,2,6,8,9,10},{2,3,7,9,10,11},{3,4,8,10,11,12}},{{1,2,7,8,9,10},{2,3,8,9,10,11},{3,4,9,10,11,12}},{{1,3,4,5,6,10},{2,4,5,6,7,11},{3,5,6,7,8,12}},{{1,3,4,5,7,10},{2,4,5,6,8,11},{3,5,6,7,9,12}},{{1,3,4,5,8,10},{2,4,5,6,9,11},{3,5,6,7,10,12}},{{1,3,4,5,9,10},{2,4,5,6,10,11},{3,5,6,7,11,12}},{{1,3,4,6,7,10},{2,4,5,7,8,11},{3,5,6,8,9,12}},{{1,3,4,6,8,10},{2,4,5,7,9,11},{3,5,6,8,10,12}},{{1,3,4,6,9,10},{2,4,5,7,10,11},{3,5,6,8,11,12}},{{1,3,4,7,8,10},{2,4,5,8,9,11},{3,5,6,9,10,12}},{{1,3,4,7,9,10},{2,4,5,8,10,11},{3,5,6,9,11,12}},{{1,3,4,8,9,10},{2,4,5,9,10,11},{3,5,6,10,11,12}},{{1,3,5,6,7,10},{2,4,6,7,8,11},{3,5,7,8,9,12}},{{1,3,5,6,8,10},{2,4,6,7,9,11},{3,5,7,8,10,12}},{{1,3,5,6,9,10},{2,4,6,7,10,11},{3,5,7,8,11,12}},{{1,3,5,7,8,10},{2,4,6,8,9,11},{3,5,7,9,10,12}},{{1,3,5,7,9,10},{2,4,6,8,10,11},{3,5,7,9,11,12}},{{1,3,5,8,9,10},{2,4,6,9,10,11},{3,5,7,10,11,12}},{{1,3,6,7,8,10},{2,4,7,8,9,11},{3,5,8,9,10,12}},{{1,3,6,7,9,10},{2,4,7,8,10,11},{3,5,8,9,11,12}},{{1,3,6,8,9,10},{2,4,7,9,10,11},{3,5,8,10,11,12}},{{1,3,7,8,9,10},{2,4,8,9,10,11},{3,5,9,10,11,12}},{{1,4,5,6,7,10},{2,5,6,7,8,11},{3,6,7,8,9,12}},{{1,4,5,6,8,10},{2,5,6,7,9,11},{3,6,7,8,10,12}},{{1,4,5,6,9,10},{2,5,6,7,10,11},{3,6,7,8,11,12}},{{1,4,5,7,8,10},{2,5,6,8,9,11},{3,6,7,9,10,12}},{{1,4,5,7,9,10},{2,5,6,8,10,11},{3,6,7,9,11,12}},{{1,4,5,8,9,10},{2,5,6,9,10,11},{3,6,7,10,11,12}},{{1,4,6,7,8,10},{2,5,7,8,9,11},{3,6,8,9,10,12}},{{1,4,6,7,9,10},{2,5,7,8,10,11},{3,6,8,9,11,12}},{{1,4,6,8,9,10},{2,5,7,9,10,11},{3,6,8,10,11,12}},{{1,4,7,8,9,10},{2,5,8,9,10,11},{3,6,9,10,11,12}},{{1,5,6,7,8,10},{2,6,7,8,9,11},{3,7,8,9,10,12}},{{1,5,6,7,9,10},{2,6,7,8,10,11},{3,7,8,9,11,12}},{{1,5,6,8,9,10},{2,6,7,9,10,11},{3,7,8,10,11,12}},{{1,5,7,8,9,10},{2,6,8,9,10,11},{3,7,9,10,11,12}},{{1,6,7,8,9,10},{2,7,8,9,10,11},{3,8,9,10,11,12}},{{1,2,3,4,5,11},{2,3,4,5,6,12}},{{1,2,3,4,6,11},{2,3,4,5,7,12}},{{1,2,3,4,7,11},{2,3,4,5,8,12}},{{1,2,3,4,8,11},{2,3,4,5,9,12}},{{1,2,3,4,9,11},{2,3,4,5,10,12}},{{1,2,3,4,10,11},{2,3,4,5,11,12}},{{1,2,3,5,6,11},{2,3,4,6,7,12}},{{1,2,3,5,7,11},{2,3,4,6,8,12}},{{1,2,3,5,8,11},{2,3,4,6,9,12}},{{1,2,3,5,9,11},{2,3,4,6,10,12}},{{1,2,3,5,10,11},{2,3,4,6,11,12}},{{1,2,3,6,7,11},{2,3,4,7,8,12}},{{1,2,3,6,8,11},{2,3,4,7,9,12}},{{1,2,3,6,9,11},{2,3,4,7,10,12}},{{1,2,3,6,10,11},{2,3,4,7,11,12}},{{1,2,3,7,8,11},{2,3,4,8,9,12}},{{1,2,3,7,9,11},{2,3,4,8,10,12}},{{1,2,3,7,10,11},{2,3,4,8,11,12}},{{1,2,3,8,9,11},{2,3,4,9,10,12}},{{1,2,3,8,10,11},{2,3,4,9,11,12}},{{1,2,3,9,10,11},{2,3,4,10,11,12}},{{1,2,4,5,6,11},{2,3,5,6,7,12}},{{1,2,4,5,7,11},{2,3,5,6,8,12}},{{1,2,4,5,8,11},{2,3,5,6,9,12}},{{1,2,4,5,9,11},{2,3,5,6,10,12}},{{1,2,4,5,10,11},{2,3,5,6,11,12}},{{1,2,4,6,7,11},{2,3,5,7,8,12}},{{1,2,4,6,8,11},{2,3,5,7,9,12}},{{1,2,4,6,9,11},{2,3,5,7,10,12}},{{1,2,4,6,10,11},{2,3,5,7,11,12}},{{1,2,4,7,8,11},{2,3,5,8,9,12}},{{1,2,4,7,9,11},{2,3,5,8,10,12}},{{1,2,4,7,10,11},{2,3,5,8,11,12}},{{1,2,4,8,9,11},{2,3,5,9,10,12}},{{1,2,4,8,10,11},{2,3,5,9,11,12}},{{1,2,4,9,10,11},{2,3,5,10,11,12}},{{1,2,5,6,7,11},{2,3,6,7,8,12}},{{1,2,5,6,8,11},{2,3,6,7,9,12}},{{1,2,5,6,9,11},{2,3,6,7,10,12}},{{1,2,5,6,10,11},{2,3,6,7,11,12}},{{1,2,5,7,8,11},{2,3,6,8,9,12}},{{1,2,5,7,9,11},{2,3,6,8,10,12}},{{1,2,5,7,10,11},{2,3,6,8,11,12}},{{1,2,5,8,9,11},{2,3,6,9,10,12}},{{1,2,5,8,10,11},{2,3,6,9,11,12}},{{1,2,5,9,10,11},{2,3,6,10,11,12}},{{1,2,6,7,8,11},{2,3,7,8,9,12}},{{1,2,6,7,9,11},{2,3,7,8,10,12}},{{1,2,6,7,10,11},{2,3,7,8,11,12}},{{1,2,6,8,9,11},{2,3,7,9,10,12}},{{1,2,6,8,10,11},{2,3,7,9,11,12}},{{1,2,6,9,10,11},{2,3,7,10,11,12}},{{1,2,7,8,9,11},{2,3,8,9,10,12}},{{1,2,7,8,10,11},{2,3,8,9,11,12}},{{1,2,7,9,10,11},{2,3,8,10,11,12}},{{1,2,8,9,10,11},{2,3,9,10,11,12}},{{1,3,4,5,6,11},{2,4,5,6,7,12}},{{1,3,4,5,7,11},{2,4,5,6,8,12}},{{1,3,4,5,8,11},{2,4,5,6,9,12}},{{1,3,4,5,9,11},{2,4,5,6,10,12}},{{1,3,4,5,10,11},{2,4,5,6,11,12}},{{1,3,4,6,7,11},{2,4,5,7,8,12}},{{1,3,4,6,8,11},{2,4,5,7,9,12}},{{1,3,4,6,9,11},{2,4,5,7,10,12}},{{1,3,4,6,10,11},{2,4,5,7,11,12}},{{1,3,4,7,8,11},{2,4,5,8,9,12}},{{1,3,4,7,9,11},{2,4,5,8,10,12}},{{1,3,4,7,10,11},{2,4,5,8,11,12}},{{1,3,4,8,9,11},{2,4,5,9,10,12}},{{1,3,4,8,10,11},{2,4,5,9,11,12}},{{1,3,4,9,10,11},{2,4,5,10,11,12}},{{1,3,5,6,7,11},{2,4,6,7,8,12}},{{1,3,5,6,8,11},{2,4,6,7,9,12}},{{1,3,5,6,9,11},{2,4,6,7,10,12}},{{1,3,5,6,10,11},{2,4,6,7,11,12}},{{1,3,5,7,8,11},{2,4,6,8,9,12}},{{1,3,5,7,9,11},{2,4,6,8,10,12}},{{1,3,5,7,10,11},{2,4,6,8,11,12}},{{1,3,5,8,9,11},{2,4,6,9,10,12}},{{1,3,5,8,10,11},{2,4,6,9,11,12}},{{1,3,5,9,10,11},{2,4,6,10,11,12}},{{1,3,6,7,8,11},{2,4,7,8,9,12}},{{1,3,6,7,9,11},{2,4,7,8,10,12}},{{1,3,6,7,10,11},{2,4,7,8,11,12}},{{1,3,6,8,9,11},{2,4,7,9,10,12}},{{1,3,6,8,10,11},{2,4,7,9,11,12}},{{1,3,6,9,10,11},{2,4,7,10,11,12}},{{1,3,7,8,9,11},{2,4,8,9,10,12}},{{1,3,7,8,10,11},{2,4,8,9,11,12}},{{1,3,7,9,10,11},{2,4,8,10,11,12}},{{1,3,8,9,10,11},{2,4,9,10,11,12}},{{1,4,5,6,7,11},{2,5,6,7,8,12}},{{1,4,5,6,8,11},{2,5,6,7,9,12}},{{1,4,5,6,9,11},{2,5,6,7,10,12}},{{1,4,5,6,10,11},{2,5,6,7,11,12}},{{1,4,5,7,8,11},{2,5,6,8,9,12}},{{1,4,5,7,9,11},{2,5,6,8,10,12}},{{1,4,5,7,10,11},{2,5,6,8,11,12}},{{1,4,5,8,9,11},{2,5,6,9,10,12}},{{1,4,5,8,10,11},{2,5,6,9,11,12}},{{1,4,5,9,10,11},{2,5,6,10,11,12}},{{1,4,6,7,8,11},{2,5,7,8,9,12}},{{1,4,6,7,9,11},{2,5,7,8,10,12}},{{1,4,6,7,10,11},{2,5,7,8,11,12}},{{1,4,6,8,9,11},{2,5,7,9,10,12}},{{1,4,6,8,10,11},{2,5,7,9,11,12}},{{1,4,6,9,10,11},{2,5,7,10,11,12}},{{1,4,7,8,9,11},{2,5,8,9,10,12}},{{1,4,7,8,10,11},{2,5,8,9,11,12}},{{1,4,7,9,10,11},{2,5,8,10,11,12}},{{1,4,8,9,10,11},{2,5,9,10,11,12}},{{1,5,6,7,8,11},{2,6,7,8,9,12}},{{1,5,6,7,9,11},{2,6,7,8,10,12}},{{1,5,6,7,10,11},{2,6,7,8,11,12}},{{1,5,6,8,9,11},{2,6,7,9,10,12}},{{1,5,6,8,10,11},{2,6,7,9,11,12}},{{1,5,6,9,10,11},{2,6,7,10,11,12}},{{1,5,7,8,9,11},{2,6,8,9,10,12}},{{1,5,7,8,10,11},{2,6,8,9,11,12}},{{1,5,7,9,10,11},{2,6,8,10,11,12}},{{1,5,8,9,10,11},{2,6,9,10,11,12}},{{1,6,7,8,9,11},{2,7,8,9,10,12}},{{1,6,7,8,10,11},{2,7,8,9,11,12}},{{1,6,7,9,10,11},{2,7,8,10,11,12}},{{1,6,8,9,10,11},{2,7,9,10,11,12}},{{1,7,8,9,10,11},{2,8,9,10,11,12}},{{1,2,3,4,5,12}},{{1,2,3,4,6,12}},{{1,2,3,4,7,12}},{{1,2,3,4,8,12}},{{1,2,3,4,9,12}},{{1,2,3,4,10,12}},{{1,2,3,4,11,12}},{{1,2,3,5,6,12}},{{1,2,3,5,7,12}},{{1,2,3,5,8,12}},{{1,2,3,5,9,12}},{{1,2,3,5,10,12}},{{1,2,3,5,11,12}},{{1,2,3,6,7,12}},{{1,2,3,6,8,12}},{{1,2,3,6,9,12}},{{1,2,3,6,10,12}},{{1,2,3,6,11,12}},{{1,2,3,7,8,12}},{{1,2,3,7,9,12}},{{1,2,3,7,10,12}},{{1,2,3,7,11,12}},{{1,2,3,8,9,12}},{{1,2,3,8,10,12}},{{1,2,3,8,11,12}},{{1,2,3,9,10,12}},{{1,2,3,9,11,12}},{{1,2,3,10,11,12}},{{1,2,4,5,6,12}},{{1,2,4,5,7,12}},{{1,2,4,5,8,12}},{{1,2,4,5,9,12}},{{1,2,4,5,10,12}},{{1,2,4,5,11,12}},{{1,2,4,6,7,12}},{{1,2,4,6,8,12}},{{1,2,4,6,9,12}},{{1,2,4,6,10,12}},{{1,2,4,6,11,12}},{{1,2,4,7,8,12}},{{1,2,4,7,9,12}},{{1,2,4,7,10,12}},{{1,2,4,7,11,12}},{{1,2,4,8,9,12}},{{1,2,4,8,10,12}},{{1,2,4,8,11,12}},{{1,2,4,9,10,12}},{{1,2,4,9,11,12}},{{1,2,4,10,11,12}},{{1,2,5,6,7,12}},{{1,2,5,6,8,12}},{{1,2,5,6,9,12}},{{1,2,5,6,10,12}},{{1,2,5,6,11,12}},{{1,2,5,7,8,12}},{{1,2,5,7,9,12}},{{1,2,5,7,10,12}},{{1,2,5,7,11,12}},{{1,2,5,8,9,12}},{{1,2,5,8,10,12}},{{1,2,5,8,11,12}},{{1,2,5,9,10,12}},{{1,2,5,9,11,12}},{{1,2,5,10,11,12}},{{1,2,6,7,8,12}},{{1,2,6,7,9,12}},{{1,2,6,7,10,12}},{{1,2,6,7,11,12}},{{1,2,6,8,9,12}},{{1,2,6,8,10,12}},{{1,2,6,8,11,12}},{{1,2,6,9,10,12}},{{1,2,6,9,11,12}},{{1,2,6,10,11,12}},{{1,2,7,8,9,12}},{{1,2,7,8,10,12}},{{1,2,7,8,11,12}},{{1,2,7,9,10,12}},{{1,2,7,9,11,12}},{{1,2,7,10,11,12}},{{1,2,8,9,10,12}},{{1,2,8,9,11,12}},{{1,2,8,10,11,12}},{{1,2,9,10,11,12}},{{1,3,4,5,6,12}},{{1,3,4,5,7,12}},{{1,3,4,5,8,12}},{{1,3,4,5,9,12}},{{1,3,4,5,10,12}},{{1,3,4,5,11,12}},{{1,3,4,6,7,12}},{{1,3,4,6,8,12}},{{1,3,4,6,9,12}},{{1,3,4,6,10,12}},{{1,3,4,6,11,12}},{{1,3,4,7,8,12}},{{1,3,4,7,9,12}},{{1,3,4,7,10,12}},{{1,3,4,7,11,12}},{{1,3,4,8,9,12}},{{1,3,4,8,10,12}},{{1,3,4,8,11,12}},{{1,3,4,9,10,12}},{{1,3,4,9,11,12}},{{1,3,4,10,11,12}},{{1,3,5,6,7,12}},{{1,3,5,6,8,12}},{{1,3,5,6,9,12}},{{1,3,5,6,10,12}},{{1,3,5,6,11,12}},{{1,3,5,7,8,12}},{{1,3,5,7,9,12}},{{1,3,5,7,10,12}},{{1,3,5,7,11,12}},{{1,3,5,8,9,12}},{{1,3,5,8,10,12}},{{1,3,5,8,11,12}},{{1,3,5,9,10,12}},{{1,3,5,9,11,12}},{{1,3,5,10,11,12}},{{1,3,6,7,8,12}},{{1,3,6,7,9,12}},{{1,3,6,7,10,12}},{{1,3,6,7,11,12}},{{1,3,6,8,9,12}},{{1,3,6,8,10,12}},{{1,3,6,8,11,12}},{{1,3,6,9,10,12}},{{1,3,6,9,11,12}},{{1,3,6,10,11,12}},{{1,3,7,8,9,12}},{{1,3,7,8,10,12}},{{1,3,7,8,11,12}},{{1,3,7,9,10,12}},{{1,3,7,9,11,12}},{{1,3,7,10,11,12}},{{1,3,8,9,10,12}},{{1,3,8,9,11,12}},{{1,3,8,10,11,12}},{{1,3,9,10,11,12}},{{1,4,5,6,7,12}},{{1,4,5,6,8,12}},{{1,4,5,6,9,12}},{{1,4,5,6,10,12}},{{1,4,5,6,11,12}},{{1,4,5,7,8,12}},{{1,4,5,7,9,12}},{{1,4,5,7,10,12}},{{1,4,5,7,11,12}},{{1,4,5,8,9,12}},{{1,4,5,8,10,12}},{{1,4,5,8,11,12}},{{1,4,5,9,10,12}},{{1,4,5,9,11,12}},{{1,4,5,10,11,12}},{{1,4,6,7,8,12}},{{1,4,6,7,9,12}},{{1,4,6,7,10,12}},{{1,4,6,7,11,12}},{{1,4,6,8,9,12}},{{1,4,6,8,10,12}},{{1,4,6,8,11,12}},{{1,4,6,9,10,12}},{{1,4,6,9,11,12}},{{1,4,6,10,11,12}},{{1,4,7,8,9,12}},{{1,4,7,8,10,12}},{{1,4,7,8,11,12}},{{1,4,7,9,10,12}},{{1,4,7,9,11,12}},{{1,4,7,10,11,12}},{{1,4,8,9,10,12}},{{1,4,8,9,11,12}},{{1,4,8,10,11,12}},{{1,4,9,10,11,12}},{{1,5,6,7,8,12}},{{1,5,6,7,9,12}},{{1,5,6,7,10,12}},{{1,5,6,7,11,12}},{{1,5,6,8,9,12}},{{1,5,6,8,10,12}},{{1,5,6,8,11,12}},{{1,5,6,9,10,12}},{{1,5,6,9,11,12}},{{1,5,6,10,11,12}},{{1,5,7,8,9,12}},{{1,5,7,8,10,12}},{{1,5,7,8,11,12}},{{1,5,7,9,10,12}},{{1,5,7,9,11,12}},{{1,5,7,10,11,12}},{{1,5,8,9,10,12}},{{1,5,8,9,11,12}},{{1,5,8,10,11,12}},{{1,5,9,10,11,12}},{{1,6,7,8,9,12}},{{1,6,7,8,10,12}},{{1,6,7,8,11,12}},{{1,6,7,9,10,12}},{{1,6,7,9,11,12}},{{1,6,7,10,11,12}},{{1,6,8,9,10,12}},{{1,6,8,9,11,12}},{{1,6,8,10,11,12}},{{1,6,9,10,11,12}},{{1,7,8,9,10,12}},{{1,7,8,9,11,12}},{{1,7,8,10,11,12}},{{1,7,9,10,11,12}},{{1,8,9,10,11,12}}}

Definitions

The following definitions are mostly user interface definitions:

ClearAll[permutationsNk, doPermutationsNk]
permutationsNk[n_?IntegerQ,k_?IntegerQ]/;Mod[n,k]==0:=doPermutationsNk[n,k]

Here we define the messages generated from erroneous user input:

permutationsNk::notint="`1` is not an Integer";
permutationsNk[x_?(IntegerQ/*Not),y_?IntegerQ]:=(Message[permutationsNk::notint,x])
permutationsNk[x_?IntegerQ,y_?(IntegerQ/*Not)]:=(Message[permutationsNk::notint,y])
permutationsNk::badargs="2 does not divide into 1, exactly";
permutationsNk[x_,y_]:=(Message[permutationsNk::badargs,x,y])

This is essentially what drives the results: The way to combine different elements of the list {1,2,...,n} is done through ListCorrelate. The auxiliary function times combines the entries in the kernel (ker, ones or zeros) with the numbers in list ({1,2,...,n}). Whenever it encounters a zero in the kernel, it evaluates to Nothing. This behavior, coupled with the fact that the last argument of ListCorrelate is List allows for the construction of the desirable tuples.

Clear[times,listCorrelate]
times=(Switch[#1,0,Nothing,_,Times[##]]&);
listCorrelate[ker_,list_]:=ListCorrelate[ker,list,{1,-1},{},times,List]

An example for how listCorrelate works, consider a kernel ker={a,0,b} and list=Range[4]:

listCorrelate[{a,0,b},Range[4]]

Whenever a zero is encountered in the kernel, Nothing is returned, which in turn is wrapped in a list eg {a,Nothing,3b} which simplifies to {a,3b}.

Putting everything together:

doPermutationsNk[n_,k_]:=Module[{ker,list,firstLL,lastLL,reMo,ico,null,res,permutations,outer,apply,through,res0},
  ker=ConstantArray[1,k];
  list=Range[n];
firstLL=First/List/List;
  lastLL=Last/List/List;
  reMo=Rest/*Most;
  ico=Iconize[#1,ToString[#2]]&;
permutations[j_]:=(Join[#,ConstantArray[0,j]]&)/Permutations;
  outer[j_,args__]:=Outer[Join/(listCorrelate[#,list]&)/(ico[#,j]&),args,1];
  apply[j_]:=(With[{len=Length[{##}]},outer[j,##]//(Flatten[#,len-1]&)]&)/(ico[#,Length[#]]&);
  through[j_]:={firstLL,reMo/*permutations[j],lastLL};
{null,{res}}=Reap@Do[ker//(Through[through[j][#]]&)/Apply[apply[j]]/Sow,{j,n-k}];
res0=listCorrelate[ConstantArray[1,k],list]//(ico[#,Length[#]]&)/List/(ico[#,Length[#]]&);
  Join[{res0},res]//(ico[#,Length[#]]&)
]

The following two expressions deal with boundary values for $k$:

doPermutationsNk[n_,1]:=Module[{list,ico,res0},
  list=Range[n];
ico=Iconize[#1,ToString[#2]]&;
res0=list//List/Transpose/(ico[#,Length[#]]&)/List/(ico[#,Length[#]]&);
  Join[{res0},{}]//(ico[#,Length[#]]&)
]

and

doPermutationsNk[n_,n_]:=Module[{list,ico,res0},
  list=Range[n];
ico=Iconize[#1,ToString[#2]]&;
res0=list//List/(ico[#,Length[#]]&)/List/*(ico[#,Length[#]]&);
  Join[{res0},{}]//(ico[#,Length[#]]&)
]

score 0 · Answer 3 · answered Feb 20 '23 at 03:06

Here is one possible solution:

perm[set_List, k_Integer] := If[Length[set]<2k,
  List/@Subsets[set,{k}],
  Flatten[
    Function[s,Prepend[#,s]&/@perm[Complement[
     Drop[set,First@FirstPosition[set,First[s]]],s],k]]
     /@Subsets[set, {k}], 1]
  ];
perm[n_Integer, k_Integer] := perm[Range[n], k];

It might be not the most effective, but it is much faster than @Daniel's main function.

For example,

In[1]:= Timing[perm[10, 2]]
Out[1]:= {0.1,{{{1, 2}, {3, 4}, {5, 6}, {7, 8}, {9, 10}},...}}(*4260 elements*)

Permutations with subsets not containing the same elements

3 Answers3

Definitions

Linked