Cod sursa(job #282259)

Utilizator THE_GAMEAndrei Alexandru THE_GAME Data 17 martie 2009 10:48:41
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.68 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.