Cod sursa(job #51689)

Utilizator floringh06Florin Ghesu floringh06 Data 16 aprilie 2007 14:19:45
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.21 kb
{$IFDEF NORMAL}
  {$I-,OBJECTCHECKS-,Q-,R-,S-}
{$ENDIF NORMAL}
  {$I+,OBJECTCHECKS-,Q+,R+,S-}
{$IFDEF RELEASE}
  {$I-,OBJECTCHECKS-,Q-,R-,S-}
{$ENDIF RELEASE}

type matr=array[0..18,0..250000] of longword;

var fi,fo:text;
    j,i,n,m,a,b,ct:longint;
    s : matr;
    p:array[1..32768] of byte;
    c:char;

function getnn:longint;
var rez:longint;
begin
rez:=0;
while (ord(c) >=48) and (ord(c) <= 57) do
        begin
        rez:=rez*10 + ord(c) - 48;
        read(fi,c);
        end;
getnn:=rez;
while (((ord(c)  < 48) or ( ord(c) > 57))) and ( ord(c) <> 26)  do
       read(fi,c);
end;


begin

 assign(fi,'stramosi.in');
 reset(fi);
 settextbuf(fi,p); read(fi,c);
 assign(fo,'stramosi.out'); rewrite(fo);
 //readln(fi,n,m);
 n:=getnn; m:=getnn;
 for i:=1 to n do
  begin
  //read(fi,s[0,i]);
  s[0,i]:=getnn;
  end;
 while (1 shl ct)<=n do
   inc(ct);
 dec(ct);
 for i:=1 to ct do
  for j:=1 to n do
    s[i,j]:=s[i-1,s[i-1,j]];
for i:=1 to m do
begin
  //readln(fi,a,b);
  a:=getnn; b:=getnn;
  while b>0 do
  begin
   ct:=0;
   while (1 shl ct) <= b do
    inc(ct);
   dec(ct);
   b:=b-(1 shl ct);
   a:=s[ct,a];
  end;
writeln(fo,a);
end;
close(fo);
end.