Cod sursa(job #254823)

Utilizator bodyionitaIonita Bogdan Constantin bodyionita Data 7 februarie 2009 17:59:48
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.6 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.