Cod sursa(job #337132)

Utilizator mlazariLazari Mihai mlazari Data 2 august 2009 17:33:14
Problema Stramosi Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.26 kb
Program Stramosi;  
var m,n : longint;  
    S : array[0..250000,0..17] of longint;  
    log2 : array[1..250000] of integer;  
    Intrare,Iesire : text;  
  
procedure Citeste;  
var i : longint;  
begin  
  assign(Intrare,'stramosi.in');  
  reset(Intrare);  
  readln(Intrare,n,m);  
  for i:=1 to n do read(Intrare,S[i,0]);  
end;  
  
procedure CalcLog2;  
var i : longint;  
    p : integer;  
begin  
  p:=0;  
  while 1 shl (p+1)-1<=n do  
   begin  
     for i:=1 shl p to 1 shl (p+1)-1 do log2[i]:=p;  
     p:=p+1;  
   end;  
  for i:=1 shl p to n do log2[i]:=p;  
end;  
  
procedure Calcule;  
var i,j : longint;  
begin  
  CalcLog2;  
  for i:=0 to 17 do S[0,i]:=0;  
  for i:=1 to log2[n] do  
   for j:=1 to n do S[j,i]:=S[S[j,i-1],i-1];  
end;  
  
procedure Procesare;  
var i,Q,P : longint;  
    lg : integer;  
begin  
  assign(Iesire,'stramosi.out');  
  rewrite(Iesire);  
  for i:=1 to m do  
   begin  
     readln(Intrare,Q,P);  
     while (P>0) and (Q>0) do  
      begin  
        lg:=log2[P];  
        Q:=S[Q,lg];  
        P:=P-1 shl lg;  
      end;  
     writeln(Iesire,Q);  
   end;  
  close(Intrare);  
  close(Iesire);  
end;  
  
begin  
  Citeste;  
  Calcule;  
  Procesare;  
end.