纪中暑假培训：Date 4：【GDOI2003】排列的编码 (Standard IO)

2018.07.09【2018提高组】模拟C组：排列的编码

问题描述：

对于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)。所有数据的结果都输出到一行中，用逗号分开。

Sample Input

(4,(3,2,1,4))
(5,(3,5,1,2,4))
-1

Sample Output

15,67

思路：阶层与高精度

var
 n,m,i,j,k,tot,kk:longint;
 a,anss:array[0..55] of string;
 b:array[0..55] of longint;
 s,ss,ans,kkk:string;
 keyy:boolean;


function gjdj(nn,mm:string):string;
 var
 a,b,c:array[0..500001] of longint;
 i,j,dq,jw,len,lena,lenb,lenc,x:longint;
 ss,sss,answer:string;
 key:boolean;
begin
 lena:=length(nn);
 lenb:=length(mm);
 answer:='';
 fillchar(a,sizeof(a),0);
 fillchar(b,sizeof(b),0);
 fillchar(c,sizeof(c),0);
 for i:=1 to lena do a[lena-i+1]:=ord(nn[i])-48;
 for i:=1 to lenb do b[lenb-i+1]:=ord(mm[i])-48;
 i:=1; x:=0;
 while (i<=lena) or (i<=lenb) do
  begin
    c[i]:=a[i]+b[i]+x;
    x:=c[i] div 10;
    c[i]:=c[i] mod 10;
    i:=i+1;
  end;
  if x>0 then
     begin lenc:=i; c[i]:=x; end
           else lenc:=i-1;
  for i:=lenc downto 1 do
   begin
    str(c[i],sss);
    answer:=answer+sss;
   end;
  exit(answer);
end;

function gjdc(nn,mm:string):string;
 var
 a,b,c:array[0..100001] of longint;
 i,j,dq,jw,lena,lenb,x,lenc:longint;
 ss,sss,answer:string;
begin
 answer:='';
 lena:=length(nn);
 lenb:=length(mm);
 fillchar(a,sizeof(a),0);
 fillchar(b,sizeof(b),0);
 fillchar(c,sizeof(c),0);
 for i:=1 to lena do a[lena-i+1]:=ord(nn[i])-48;
 for i:=1 to lenb do b[lenb-i+1]:=ord(mm[i])-48;
 for i:=1 to lena do
 begin
  x:=0;
  for j:=1 to lenb do
   begin
    c[i+j-1]:=a[i]*b[j]+x+c[i+j-1];
    x:=c[i+j-1] div 10;
    c[i+j-1]:=c[i+j-1] mod 10;
   end;
   c[i+j]:=x;
 end;
 lenc:=lena+lenb;
 while (c[lenc]=0) and (lenc>1) do dec(lenc);
 for i:=lenc downto 1 do
 begin
  str(c[i],sss);
  answer:=answer+sss;
 end;
 exit(answer);
end;

procedure work;
 var
 i,j,l,r:longint;
 ss:string;
begin
 r:=pos(',',s);
 ss:=copy(s,2,r-2);
 val(ss,k);
 delete(s,1,1+r);
 j:=0;
 for i:=1 to k-1 do
  begin
   r:=pos(',',s);
   ss:=copy(s,1,r-1);
   val(ss,b[i]);
   delete(s,1,r);
  end;
 r:=pos('>',s);
 ss:=copy(s,1,r-1);
 val(ss,b[k]);
end;

begin
 s:='00000';
 a[1]:='1';
 for i:=2 to 52 do
 begin
  str(i,ss);
  a[i]:=gjdc(a[i-1],ss);
 end;
 while s<>'-1' do
 begin
  readln(s);
  if s<>'-1' then
  begin
  work;
  ans:='0';
  for i:=1 to k-1 do
   begin
   tot:=0;
    for j:=1 to i-1 do
     if b[i]>b[j] then inc(tot);
     kk:=b[i]-tot-1;
     str(kk,kkk);
     ans:=gjdj(ans,gjdc(kkk,a[k-i]));
   end;
  if not(keyy) then begin
                   keyy:=true;
                   write(gjdj(ans,'1'));
                   end
              else write(',',gjdj(ans,'1'));
  end;
 end;
end.