Cod sursa(job #30928)

Utilizator spike05Dan Radu spike05 Data 15 martie 2007 12:23:59
Problema Stramosi Scor 80
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.15 kb
{$mode objfpc} 
{$inline on} 
{$coperators on} 
type TQueue=class(TObject)
      private
       data:array of integer;
       hd,rh,wh:integer; 
      public 
       procedure Push(v:integer);inline; 
       function Pop():integer;inline; 
       function Available():boolean;inline; 
       constructor Create(size:integer); 
     end; 

procedure TQueue.Push(v:integer);inline;
begin
  inc(wh);
  if wh>hd then wh:=0; 
  data[wh]:=v; 
end; 

function TQueue.Pop():integer;inline;
begin
  inc(rh); 
  if rh>hd then rh:=0;
  Result:=data[rh]; 
end; 

function TQueue.Available():boolean;inline;
begin
  Result:=rh<>wh; 
end; 

constructor TQueue.Create(size:integer);
begin
  setLength(data,size);
  hd:=High(data);
  rh:=0;
  wh:=0; 
end; 

var a:array[0..250000] of array of integer; 
    l,p:array[0..250000] of integer; 
    payload:array[0..250000] of array[0..18] of integer; 
    u:array[0..250000] of boolean; 
    
    tmp,i,n,m:integer; 
    q:TQueue;
 
procedure DoParents(node:integer);
var f,ff,i,t:integer; 
begin
  q.Push(node);
  while q.Available() do
   begin
    t:=q.Pop();
    u[t]:=true; 
    f:=p[t];
    payload[t][0]:=f;
    for i:=1 to 18 do
     begin
      ff:=payload[t][i-1];
      payload[t][i]:=payload[ff][i-1];
     end; 
   end; 
end; 

function RetrParent(p,c:integer):integer;
var i:integer; 
begin
  i:=18;
  while c>0 do
   begin
    while (1 shl i) > c do dec(i); 
    c-=(1 shl i);
    p:=payload[p][i]; 
   end; 
  Result:=p; 
end; 

var pc,pl:integer; 

begin
  assign(input,'stramosi.in');
  assign(output,'stramosi.out');
  
  reset(input);
  rewrite(output);
  
  readln(n,m);
  
    for i:=1 to n do 
     begin
    read(p[i]);
    inc(l[p[i]]); 
   end; 
   
  for i:=0 to n do setLength(a[i],l[i]+1); 
   
  for i:=1 to n do
   begin
    inc(a[p[i]][0]); 
    a[p[i]][a[p[i]][0]]:=i;    
   end; 
 
  q:=TQueue.Create(n); 
  
  for i:=1 to n do
   if not u[i] then DoParents(i); 
  
  q.Destroy(); 
  
  for i:=1 to m do 
   begin
    readln(pc,pl);
    writeln(RetrParent(pc,pl)); 
   end; 
  
  close(input);
  close(output); 
end.