Cod sursa(job #172141)

Utilizator black_pussaasd sada black_puss Data 5 aprilie 2008 20:24:18
Problema Stramosi Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.81 kb
program stramosi;
var f,g:text;
    a:array[1..25000]of integer;
    m,n,p,i,q:longint;

procedure calculare;
var s,stra,pas,poz:longint;
    ok:boolean;
begin
 pas:=0; stra:=a[q]; poz:=q; ok:=false;
 if stra<>0 then
  begin
   repeat
    inc(pas);
    poz:=stra;
    stra:=a[stra];
    if stra=0 then
     ok:=true;
   until (pas=p) or (ok=true);
   if ok=true then
    begin
     if pas=p then
      writeln(g,poz);
     if pas<p then
      writeln(g,'0');
    end;
   if ok=false then
    writeln(g,poz);
  end else
  writeln(g,'0');
end;

begin
  assign(f,'stramosi.in');
  reset(f);
  readln(f,n,m);
  assign(g,'stramosi.out');
  rewrite(g);
  for i:=1 to n do
   read(f,a[i]);
  for i:=1 to m do
   begin
    readln(f,q,p);
    calculare;
   end;
  close(f);
  close(g);
end.