Re: Re: UnrankPermutation newbie problem .. Combinatorica Package
- To: mathgroup at smc.vnet.net
- Subject: [mg49985] Re: [mg49964] Re: UnrankPermutation newbie problem .. Combinatorica Package
- From: DrBob <drbob at bigfoot.com>
- Date: Mon, 9 Aug 2004 04:29:24 -0400 (EDT)
- References: <cf22sg$7tf$1@smc.vnet.net> <200408080937.FAA21881@smc.vnet.net>
- Reply-to: drbob at bigfoot.com
- Sender: owner-wri-mathgroup at wolfram.com
If there were a simple formula, Mathematica would use it!
The algorithm is written as simply as it can be, but I'll try to puzzle it out for you (as I did for myself).
First of all, you left out half the code, namely the UP function:
UP[r_Integer, n_Integer] :=
Module[{r1 = r, q = n!},
Table[r1 = Mod[r1, q];
q = q/(n - i + 1);
Quotient[r1, q] + 1,
{i, n}
]
]
To understand what UP does, look at a few examples of UP versus UnrankPermutation, applied to the same arguments. Here are the first, last, and 341st permutations for the elements from 1 to 6:
n=6;
f={UP[#,n],UnrankPermutation[#,n]}&;
f@1
{{1,1,1,1,2,1},{1,2,3,4,6,5}}
f@(n!)
{{1,1,1,1,1,1},{1,2,3,4,5,6}}
f@341
{{3,5,1,3,2,1},{3,6,1,5,4,2}}
The elements returned by UP are indices into the set {1,...,12} in a sense, but "1" doesn't mean the first element; it means the first element not yet chosen. Similarly, "2" means the second element not yet chosen.
UnrankPermutation calls UP to compute these indices and then uses the more-or-less obvious algorithm, using those indices, to return the corresponding permutation. For the third example (r=341), the work of UnrankPermutation looks like this:
unrankPermutation[r_Integer,{}]:={}
unrankPermutation[r_Integer,l_List]:=
Module[{s=l,k,t,p=UP[Mod[r,Length[l]!],Length[l]]},
Table[k=s[[t=p[[i]]]];
s=Delete[s,t];Print@{s,t,k};
k,{i,Length[p]}]]
unrankPermutation[r_Integer,n_Integer?
Positive]:=unrankPermutation[r,Range[n]]
unrankPermutation[341,6]
{{1,2,4,5,6},3,3}
{{1,2,4,5},5,6}
{{2,4,5},1,1}
{{2,4},3,5}
{{2},2,4}
{{},1,2}
{3,6,1,5,4,2}
At each step in unrankPermutation's Table statement I've printed {s,t,k} at the end of that step. s begins as the total list {1,2,3,4,5,6} but loses each element as it is selected. The corresponding index returned by UP is used at each stage both to choose an element and to remove it from s. As you can see, this makes the indices mean what I said they mean.
It remains to explain how the indices are computed. For that, I modify UP to print r1, q, and n at the beginning of each stage:
UP[r_Integer,n_Integer]:=Module[{r1=r,q=n!},Table[
Print@{r1,q,i};r1=Mod[r1,q];
q=q/(n-i+1);
Quotient[r1,q]+1,{i,n}]]
UP[341,6]
{341,720,1}
{341,120,2}
{101,24,3}
{5,6,4}
{5,2,5}
{1,1,6}
{3,5,1,3,2,1}
In the first step (n=1), r1=341 and q=6!=720. r1 is reduced mod q (no change) and then q is reset to
q/(n-i-1)=720/(6-1+1)=720/6=120
(the value shown beginning the next step). The quotient of 341 divided by 120, plus 1, is 3 in this case (the first index in the result). Laying out the permutations with the first element varying most rapidly, there are 120 permutations for which the first element is 1, another 120 with first element 2, et cetera, and the 341st permutation is somewhere among the third group, those with first element 3.
Because the indices indicate choice among REMAINING elements, all the other steps are just like that, but with smaller r1 and q. It's a recursive sort of algorithm, conceptually shrinking the list. In the last step, there's only one index left to choose, so UP's result always ends with a 1.
Another way of expressing the result is this:
(3-1)5!+(5-1)4!+(1-1)3!+(3-1)2!+(2-1)1!
341
UP determines the digits {3,5,1,3,2} that work in that expression, so it's basically computing the number's "digits" in a factorial base system. Here's a recursive implementation:
up[r_Integer, 1] := {1}
up[r_Integer, n_Integer] := Module[{r1, q = (n - 1)!},
r1 = Quotient[r, q];
Flatten@{1 + r1, up[r - r1 q, n - 1]}]
up[341, 6]
{3, 5, 1, 3, 2, 1}
Here's the identical algorithm for base 2 digits:
Clear[binary]
binary[r_Integer, 1] := {r}
binary[r_Integer, n_Integer] :=
Module[{r1, q = 2^(n - 1)},
r1 = Quotient[r, q];
Flatten[{r1, binary[
r - r1*q, n - 1]}]]
binary[341, 9]
{1, 0, 1, 0, 1, 0, 1, 0, 1}
RealDigits[341,2]
{{1,0,1,0,1,0,1,0,1},9}
Both algorithms (as written) depend on having n large enough; UnrankPermutation ensures that by reducing r modulo n factorial.
I hope that helps!
Bobby
DrBob at bigfoot.com
www.eclecticdreams.net
On Sun, 8 Aug 2004 05:37:47 -0400 (EDT), BV <dont at bug.me> wrote:
> BV wrote:
>
>> I found that calling NthPermutation via MathLink in C++ is rather costly
>> for my purposes, therefore I'm inquiring to re-write the function
>> entirely in C++. I hope by eliminating unnecessary calls to MathLink
>> this would speed up my program significantly.
>>
>> As, I admit, I am not very versed in Mathematics itself can anyone point
>> me in the direction where to start; how this function works; what
>> formula is used, etc.
>> Thank you
>>
> I found in the "combinatorica.m" file that this function is obsolete and
> that UnrankPermutation[] function should be used instead. This is the
> code as it should work (from the "combinatorica.m" file):
>
> UnrankPermutation[r_Integer, {}] := {}
> UnrankPermutation[r_Integer, l_List] :=
> Module[{s = l, k, t, p = UP[Mod[r, Length[l]!], Length[l]]},
> Table[k = s[[t = p[[i]] ]];
> s = Delete[s, t];
> k,
> {i, Length[ p ]}
> ]
> ]
>
> UnrankPermutation[r_Integer, n_Integer?Positive] :=
> UnrankPermutation[r, Range[n]]
>
> Can someone please write this as an algorithm or a formula as I don't
> have any books on Mathematica and this looks complicated; a plain
> formula for this would do!
>
>
>
--
- References:
- Re: UnrankPermutation newbie problem .. Combinatorica Package
- From: BV <dont@bug.me>
- Re: UnrankPermutation newbie problem .. Combinatorica Package