Cod sursa(job #14835)

Utilizator Programmer01Mierla Laurentiu Marian Programmer01 Data 9 februarie 2007 22:42:50
Problema Stramosi Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.37 kb
program p1;
type tip=0..131072;
var mat:array[0..131072,0..16] of 0..131072;
    a,b,c,gr,s:array[0..131072] of word;
    n,m,i,j,p,q,x,y:tip;
    f,g:text;
procedure parc(vf:tip);
var k:word;
begin
for k:=0 to gr[vf]-1 do
begin
q:=b[s[vf]+k];
c[q]:=c[vf]+1;
a[c[q]]:=q;
p:=c[q];
mat[q,1]:=a[p-1];
i:=1;
j:=1;
repeat
j:=j+1;
i:=i+(i xor (i-1)) and i;
mat[q,j]:=a[p-i];
until p-i<1;
mat[q,0]:=i div 2;
parc(q);
end;
end;
begin
assign(f,'stramosi.in');
reset(f);
assign(g,'stramosi.out');
rewrite(g);
read(f,n,m);
x:=1;
for i:=1 to n do
begin
read(f,a[i]);
gr[a[i]]:=gr[a[i]]+1;
if a[i]=0 then
begin
mat[0,x]:=i;
x:=x+1;
end;
end;
y:=0;
s[0]:=0;
for i:=0 to n-1 do
begin
y:=y+gr[i];
s[i+1]:=y+1;
c[i+1]:=y+1;
end;
for i:=0 to n do
begin
y:=a[i];
b[c[a[i]]]:=i;
c[a[i]]:=c[a[i]]+1;
end;
for y:=1 to x-1 do
begin
c[mat[0,y]]:=1;
a[1]:=mat[0,y];
parc(mat[0,y]);
end;
for y:=1 to m do
begin
readln(f,q,p);
x:=0;
j:=0;
repeat
j:=j+1;
b[j]:=p mod 2;
if b[j]=1 then
begin
x:=x+1;
c[x]:=1 shl (j-1);
mat[0,x]:=j;
end;
p:=p div 2;
until p<=1;
if p=1 then
begin
j:=j+1;
b[j]:=p;
x:=x+1;
c[x]:=1 shl (j-1);
mat[0,x]:=j;
end;
x:=x+1;
if mat[q,0]=0 then q:=0
else
while x>1 do
begin
x:=x-1;
if mat[q,0]<c[x] then
begin
i:=x;
q:=0;
end
else q:=mat[q,mat[0,x]];
end;
writeln(g,q);
end;
close(g);
close(f);
end.