Nu aveti permisiuni pentru a descarca fisierul grader_test13.ok

Cod sursa(job #142968)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 25 februarie 2008 18:20:15
Problema Order Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.29 kb
var v:array[1..100000]of integer;
    u,n,i,j,k,p,o,l:longint;
    f:text;
procedure nro(a,b,c:longint);
begin
   if b<=p then o:=o+v[c]
           else begin if a<b then begin nro(a,(a+b)div 2,c*2);
                                        if p>=(b+a) div 2+1 then nro((a+b)div 2+1,b,c*2+1);
                                  end;
                end;
end;
procedure dis(a,b,c:longint);
begin
   if a=b then begin p:=a;
                     v[c]:=0;
               end
          else begin if l<=v[c*2]     then dis(a,(a+b)div 2,c*2)
                                      else begin l:=l-v[c*2];
                                                 dis((a+b)div 2+1,b,c*2+1);
                                           end;
                     v[c]:=v[c*2]+v[c*2+1];
               end;
end;
begin
   assign(f,'order.in');
   reset(f);
   read(f,n);
   close(f);
   while 1 shl u<n do
   u:=u+1;
   for i:=1 shl u to 1 shl u+n-1 do
   v[i]:=1;
   for j:=u-1 downto 0 do
   for i:=1 shl j to 1 shl (j+1)-1do
   v[i]:=v[i*2]+v[i*2+1];
   p:=1;
   assign(f,'order.out');
   rewrite(f);
   for i:=1 to n do
   begin
   o:=0;
   nro(1,1 shl u,1);
   l:=(o+i)mod(n-i+1);
   if l=0 then l:=n-i+1;
   dis(1,1 shl u,1);
   write(f,p,' ');
   end;
   writeln(f);
   close(f);
end.