Cod sursa(job #31443)

Utilizator andrewgPestele cel Mare andrewg Data 16 martie 2007 00:22:13
Problema Order Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.28 kb
const f_in = 'order.in';
      f_out = 'order.out';
      maxn = 65000;

type nod = record
        x,y,v:longint;
     end;

var f:text;
    n,i,j,p,k,t,max:longint;
    a:array[1..maxn]of longint;
    c:array[1..maxn]of nod;

procedure readdata;
begin
   assign(f,f_in);
   reset(f);
   readln(f,n);
   close(f);
end;

procedure find(k:longint);
begin
   t:=t+c[k].x;
   if c[k].v<>0 then
   begin
      write(f,c[k].v,' ');
      exit;
   end;
   if t>=p then
   begin
      t:=t-c[k].x;
      find(2*k);
      dec(c[k].x);
   end
      else
   begin
      find(2*k+1);
      t:=t-c[k].y;
      dec(c[k].y);
   end;
end;

procedure solve;
begin
   assign(f,f_out);
   rewrite(f);
   i:=1;
   t:=0;
   max:=1;
   while max<n do max:=max*2;
   k:=max;
   while t<n do
   begin
      if i>1 then
      begin
         k:=c[i div 2].x;
      end;
      c[i].x:=k div 2;
      c[i].y:=k div 2;
      if c[i].x+c[i].y=0 then
      begin
         inc(t);
         c[i].v:=t;
      end;
      inc(i);
   end;
   p:=1;
   for i:=1 to n do
   begin
      p:=p+i;
      p:=p mod (n-i+1);
      if p=0 then p:=n-i+1;
      t:=0;
      find(1);
      p:=p-1;
   end;
   writeln(f);
   close(f);
end;

begin
   readdata;
   solve;
end.