Cod sursa(job #227140)

Utilizator doruletzPetrican Teodor doruletz Data 3 decembrie 2008 19:52:22
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.14 kb
const nmax = 250010;  
        mmax = 300010;  
type plist = ^tlist;  
        tlist = record  
                x,rez:longint;  
                next:plist;  
                end;  
      rr= record  
        head,last:plist;  
        end;  
var     st:array[1..nmax] of longint;  
        rez: array[1..mmax] of longint;  
        cerere,fii: array[1..nmax] of rr;  
        n,m,nst,j:longint;  
  
procedure add(list,x,rez:longint);  
var p:plist;  
begin  
        new(p); p^.x:=x; p^.rez:=rez; p^.next:=nil;  
        if cerere[list].head = nil then  
                cerere[list].head:=p  
        else    cerere[list].last^.next:=p;  
        cerere[list].last:=p;  
end;  
  
procedure addfiu(tata,fiu:longint);  
var p:plist;  
begin  
        new(p); p^.x:=fiu; p^.next:=nil;  
        if fii[tata].head = nil then  
                fii[tata].head:=p  
        else    fii[tata].last^.next:=p;  
        fii[tata].last:=p;  
end;  
  
procedure citire;  
var i,a,a1,a2:longint;  
begin  
assign(input,'stramosi.in');reset(input);  
readln(n,m);  
for i:=1 to n do  
        begin  
        read(a);  
        if a = 0 then  
                begin  
                inc(nst);  
                st[nst]:=i;  
                end  
        else    addfiu(a,i);  
        end;  
for i:=1 to m do  
        begin  
        readln(a1,a2);  
        add(a1,a2,i);  
        end;  
close(input);  
end;  
  
  
procedure dfs(ad:longint);  
var p:plist;  
begin  
p:=cerere[st[nst]].head;  
while p <> nil do  
        begin  
        if p^.x >= ad then  
                rez[p^.rez]:=0  
        else rez[p^.rez]:=st[nst-p^.x];  
        p:=p^.next;  
        end;  
  
p:=fii[st[nst]].head;  
while p <> nil do  
        begin  
        inc(nst);  
        st[nst]:=p^.x;  
        dfs(ad+1);  
        dec(nst);  
        p:=p^.next;  
        end;  
end;  
  
begin  
citire;  
for  j:=nst downto 1 do  
        begin  
        dfs(1);  
        dec(nst);  
        end;  
assign(output,'stramosi.out'); rewritE(output);  
for j:=1 to m do  
        writeln(rez[j]);  
close(output);  
end.