<< Combinatorica`
Permutations[Range[0, 9]][[1000000]] // AbsoluteTiming
Nest[NextPermutation, Range[0, 9], 1*^6 - 1] // AbsoluteTiming
I want to save memory, so I tried NextPermutation ,but it's kind of slow, why?
$\begingroup$
$\endgroup$
2
1 Answer
$\begingroup$
$\endgroup$
1
You need UnrankPermutation
<< Combinatorica`;
UnrankPermutation[10^6 - 1, Range[0, 9]] // AbsoluteTiming
{0.0001106, {2, 7, 8, 3, 9, 1, 5, 4, 6, 0}}
I wrote a takePermutation function, maybe you are interested
Quiet[<< Combinatorica`];
Clear[cf, takePermutation];
cf = Compile[{{l, _Integer, 1}, {num, _Integer}},
Module[{res = l, n = Length @ l, i, j, nl, tmp},
Table[
nl = res;
i = n - 1;
While[nl[[i]] > nl[[i + 1]], i--];
j = n;
While[nl[[j]] < nl[[i]], j--];
tmp = nl[[i]];
nl[[i]] = nl[[j]];
nl[[j]] = tmp;
res = nl[[Join[Range[i], Range[n, i + 1, -1]]]]
, {num}]
], CompilationTarget -> "C", RuntimeOptions -> "Speed"
];
takePermutation[l_?VectorQ, i1_Integer, i2_Integer] :=
If[i1 == 1, Join[{l}, cf[UnrankPermutation[i1 - 1, l], i2 - i1]],
cf[UnrankPermutation[i1 - 2, l], i2 - i1 + 1]] /; 0 < i1 <= i2;
r1 = takePermutation[Range[11], 11! - 10^5, 11!]; // AbsoluteTiming
r2 = Take[Permutations[Range[11]], {11! - 10^5, 11!}]; // AbsoluteTiming
r1 == r2
{0.0396038, Null}
{0.777691, Null}
True
-
$\begingroup$ It is a great answer. $\endgroup$ Commented Sep 17, 2020 at 1:21
Nest, then you understand the iteration is executed 999999 times. $\endgroup$NextPermutation, you could usePermutationFromIndexto get the 999999+1th lexicographic permutation straight away and very quickly.ResourceFunction["PermutationFromIndex"][10^6, 10] - 1gives{2, 7, 8, 3, 9, 1, 5, 4, 6, 0}. $\endgroup$