【GDOI2003】排列的编码

这是我第一次写blog，如果有写得不好的地方，希望大家留言修改。

---

Description

对于n个元素的排列P=(p1,p2,……,pn)，请你编写一个程序，在不构造出所有排列的情况下，直接输出该排列在按字典序排列的字典中的序数d(p),其中p1∈{1,2,3,…,n},1<=n<=50。例如：n=4,若p=(2,3,4,1)，则d(p)=10;若p=(4,2,1,3),则d(p)=21

Input

每一行对应一个数据，格式为(n,(p1,p2,….,pn))其中n表示排列的元素个数，(p1,p2,…pn)就是这n个元素的某个排列。文件的最后一行只包含“-1”，表示输入文件结束。

Output

对于每个数据，输出对应的d(p)。所有数据的结果都输出到一行中，用逗号分开。

分析

这题，应该说是一道数学题，但关键是能否找到其中的规律。
于是，我们可以先从一串数中的各个各个位置入手。举个例子吧，假设有4个数，在4前面的排列有多少种，于是，我们就可以一位一位地向后推出答案。
例如 3 5 1 2 4
小于3的有1,2 两个数，而且3排第五位，于是ans+2*4！。
然后是5，小于5的有1,2,3,4，但3在前面已经用了，所以只剩下1,2,4三个数，且5在第四位，所以ans+3*3!。
而1和2的已经没有可以用的数了，所以ans+0。
然而最后一位4，其实我们不用管它，只需要加1就可以了。
所以，最后答案就是2*4!+3*3!+0+0+1=67。
有了以上的想法，我们就不难想到这题的解决方法：
首先，我们求出在每个数之前，小于它数的有多少个。例如：3 5 1 2 4 ，得到的结果就是 0 1 0 0 3。
然后再求出当前位数-1的阶乘，把求出的阶乘乘上(a[i]-b[i]-1)(a[i]为读入的数，b[i]为上一步求出的数)。
每个数位都算过之后，最后加1，就可以了，不过注意要用高精度。
在改这题的时候，我犯了很多错误，发现了自己身上存在的问题，也是收获匪浅。

代码

type
    arr=array[1..10000] of int64;
var
    a,b:array[1..50] of int64;
    s:ansistring;
    ans,xx:arr;
    i,j:longint;
    n,k,la,time:int64;
procedure xxx(var z:arr; y:int64);
var
    i,j:longint;
    l1,l2:int64;
    yy,zz:arr;
begin
    fillchar(yy,sizeof(yy),0);
    fillchar(zz,sizeof(zz),0);
    yy[1]:=y mod 10;
    yy[2]:=y div 10;
    if yy[2]>0 then l1:=2 else l1:=1;
    l2:=10000;
    while (z[l2]=0) and (l2>1) do dec(l2);
    for i:=1 to l1 do
        for j:=1 to l2 do
        begin
            zz[i+j-1]:=zz[i+j-1]+yy[i]*z[j];
            zz[i+j]:=zz[i+j]+zz[i+j-1] div 10;
            zz[i+j-1]:=zz[i+j-1] mod 10;
        end;
    z:=zz;
end;
procedure yyy(x:arr; var y:arr);
var
    i,j:longint;
    l1,l2,len:int64;
    z:arr;
begin
    fillchar(z,sizeof(z),0);
    l1:=10000;
    l2:=10000;
    while (x[l1]=0) and (l1>1) do dec(l1);
    while (y[l2]=0) and (l2>1) do dec(l2);
    if l1>l2 then len:=l1 else len:=l2;
    for i:=1 to len do
    begin
        z[i]:=x[i]+y[i]+z[i];
        z[i+1]:=z[i] div 10;
        z[i]:=z[i] mod 10;
    end;
    y:=z;
end;
begin
    assign(input,'coding.in');reset(input);
    assign(output,'coding.out');rewrite(output);
    time:=0;
    while true do
    begin
        la:=5;
        inc(time);
        readln(s);
        if s='-1' then break;
        if time>1 then write(',');
        if (s[3]>='0') and (s[3]<='9') then
        begin
            n:=(ord(s[2])-48)*10+ord(s[3])-48;
            inc(la);
        end else n:=ord(s[2])-48;
        j:=0;
        fillchar(a,sizeof(a),0);
        fillchar(b,sizeof(b),0);
        fillchar(ans,sizeof(ans),0);
        k:=0;
        for i:=5 to length(s) do
            if (s[i]=',') or (s[i]=')') then
            begin
                inc(k);
                for j:=la to i-1 do a[k]:=ord(s[j])-48+a[k]*10;
                la:=i+1;
                if s[i]=')' then break;
            end;
        for i:=1 to n do
            for j:=1 to i-1 do
                if (i>j) and (a[i]>a[j]) then inc(b[i]);
        for i:=1 to n do
        begin
            fillchar(xx,sizeof(xx),0);
            xx[1]:=1;
            k:=a[i]-b[i]-1;
            if k>0 then
            begin
                for j:=2 to n-i do xxx(xx,j);
                xxx(xx,k);
                yyy(xx,ans);
            end;
        end;
        fillchar(xx,sizeof(xx),0);
        xx[1]:=1;
        yyy(xx,ans);
        n:=10000;
        while (ans[n]=0) and (n>1) do dec(n);
        for i:=n downto 1 do write(ans[i]);
    end;
    close(input);close(output);
end.