Cod sursa(job #51687)

Utilizator andrei_infoMirestean Andrei andrei_info Data 16 aprilie 2007 14:15:24
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.44 kb
//infoarena stramosi
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;
        f:text;
        c:char;

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;

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(f,c);
        end;
getnn:=rez;
while (((ord(c)  < 48) or ( ord(c) > 57))) and ( ord(c) <> 26)  do
       read(f,c);
end;


procedure citire;
var i,a,a1,a2:longint;
    buf : array[1..65535] of byte;
begin
assign(f,'stramosi.in');reset(f); settextbuf(f,buf); read(f,c);
//readln(f,n,m);
n:=getnn; m:=getnn;
for i:=1 to n do
        begin
        //read(f,a);
        a:=getnn;
        if a = 0 then
                begin
                inc(nst);
                st[nst]:=i;
                end
        else    addfiu(a,i);
        end;
for i:=1 to m do
        begin
        //readln(f,a1,a2);
        a1:=getnn; a2:=getnn;
        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.