5
$\begingroup$

I want a function that compute number of permutation in lexicographical order. E.g.

NumberByPermutation[{3,2,1}] = 6 
NumberByPermutation[{1,2,4,3}] = 2
NumberByPermutation[{1}] = 1

maybe something like that already realesed in Mathematica?

$\endgroup$
  • 1
    $\begingroup$ Do you mean Position[Permutations[Sort@#], #]&? $\endgroup$ – Marius Ladegård Meyer Apr 23 '16 at 21:39
13
$\begingroup$

Just a note - any method generating the permutations and the searching will get very slow very quickly, and blow RAM soon after.

Something like this s/b much more efficient (e.g., on my goof-top, for permutations of length 10, it's ~30,000X faster :

pr[{}] = 1;
pr[{x_, y___}] := Tr[Clip[{y}, {x, x - 1}, {1, 0}] ] Length@{y}! + pr[{y}];
$\endgroup$
2
$\begingroup$

Perhaps something like:

numByPerm = Position[Permutations[Range[Length@#]], #][[1,1]] &;
numByPerm /@ {{3, 2, 1}, {1, 2, 4, 3}, {1}}

{ 6, 2, 1}

$\endgroup$
2
$\begingroup$

The (now obsolete?) Combinatorica package has RankPermutation, which is very poorly documented.

It ranks permutations using a zero-indexing system.

rankPermutation /@ {{3, 2, 1}, {1, 2, 4, 3}, {1}}

{5,1,0}

The function seems to be based on the code given in Computational Discrete Mathematics by Sriram Pemmaraju and Steven Skiena, p. 60. Code for PermutationQ (also poorly documented) is given on p. 55 of this ref.

I am reproducing the code below, and I hope I am not breaking any rules by doing so.

In any case, it is freely available on the web.

PermutationQ[e_List] := Sort@e === Range@Length@e
rankPermutation[{1}] := 0
rankPermutation[{}] := 0
rankPermutation[p_?PermutationQ] := 
Block [{$RecursionLimit = Infinity},
(p[[1]] - 1) (Length[Rest[p]]! ) + 
rankPermutation[Map[(If [# > p[[1]], # - 1, #]) &, Rest[p]]]]

All works well with Mathematica 10, but the following inconsistency exists:

PermutationQ /@ Permutations[{2, 3, 4, 5}] // Union

{False}

This can be 'fixed' by the following slight modification:

PermutationQAlt[e_List] := Sort[e - Min[e] + 1 ] === Range@Length@e
rankPermutationAlt[{1}] := 0
rankPermutationAlt[{}] := 0
rankPermutationAlt[q_?PermutationQAlt] := 
Block [{$RecursionLimit = Infinity, p = q - Min@q + 1}, 
((p[[1]] - 1) (Length[Rest[p]]! ) + rankPermutationAlt[
 Map[(If [# > p[[1]], # - 1, #]) &, Rest[p]]])]

Examples:

rankPermutationAlt /@ {{3, 2, 1}, {1, 2, 4, 3}, {1}}

{5, 1, 0}

rankPermutationAlt /@ Permutations[{2, 3, 4, 5}]

{0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23}

$\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.