Number by permutation

Question

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?

Answer 1

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}];

Answer 2

Perhaps something like:

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

{ 6, 2, 1}

Answer 3

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}