Cod sursa(job #305902)

Utilizator danalex97Dan H Alexandru danalex97 Data 18 aprilie 2009 20:24:51
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.96 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.