Cod sursa(job #13431)

Utilizator Programmer01Mierla Laurentiu Marian Programmer01 Data 6 februarie 2007 17:18:07
Problema Stramosi Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.09 kb
program p1;
var mat:array[0..250001,0..200] of 0..250001;
    a,b,c,v:array[0..250001] of 0..250001;
    n,m,i,j,p,q,x,y:longint;
    f,g:text;
procedure parc(vf:longint);
var k:0..250001;
begin
b[vf]:=1;
for k:=1 to n do
if (a[k]=vf)and(b[k]=0) then
begin
c[k]:=c[vf]+1;
v[c[k]]:=k;
i:=1;
j:=0;
repeat
j:=j+1;
mat[k,j]:=v[c[k]-i];
i:=i+(i xor (i-1)) and i;
until c[k]-i<1;
mat[k,0]:=i div 2;
parc(k);
end;
end;
begin
assign(f,'stramosi.in');
reset(f);
assign(g,'stramosi.out');
rewrite(g);
readln(f,n,m);
x:=1;
for i:=1 to n do
begin
read(f,a[i]);
b[i]:=0;
if a[i]=0 then
begin
mat[0,x]:=i;
x:=x+1;
end;
end;
for y:=1 to x-1 do
begin
c[mat[0,y]]:=1;
v[1]:=mat[0,y];
parc(mat[0,y]);
end;
for i:=1 to m do
begin
readln(f,q,p);
x:=mat[q,0];
while (x<=p)and(x>0) do
begin
p:=p-x;
q:=mat[q,mat[q,0]];
x:=mat[q,0];
end;
if p=0 then writeln(q)
else
begin
repeat
p:=p-1;
j:=1;
y:=j;
while j<=p do
j:=j+(j xor (j-1)) and j;
j:=j div 2;
if p<>0 then
begin
y:=j;
p:=p-j;
end;
until (p=0);
writeln(g,mat[q,y]);
end;
end;
close(f);
close(g);
end.