Cod sursa(job #129605)

Utilizator ThomasFMI Suditu Thomas Thomas Data 29 ianuarie 2008 19:32:08
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.73 kb
    type pelem=^elem;  
        elem=record  
           info:longint;     
           next:pelem;     
         end;     
   var fi,fo:text;     
       s,father,dist,idist,stramos,varf:array[0..300010]of longint;  
       nod,list,a:array[0..300010]of pelem;  
       marc:array[0..300010]of byte;  
       n,i,m,v,ct,vl:longint;     
   procedure qin(var first:pelem; vl:longint);     
   var p:pelem;  
   begin    
     new(p);               {insereaza pe prima}    
     p^.info:=vl;          {pozitie}    
     p^.next:=first;     
    first:=p;     
   end;     
   procedure qout(var first:pelem; var vl:longint);     
   var p:pelem;     
   begin    
     vl:=first^.info;      {scoate din prima}    
     p:=first;             {pozitie}    
     first:=first^.next;     
     dispose(p);     
   end;     
   procedure df(nodulet:longint);     
   var vl,valo,rez:longint;  
   begin    
     s[nodulet]:=1;     
     while list[nodulet]<>nil do    
       begin    
         qout(list[nodulet],vl);     
         if (s[vl]=0) then    
           begin    
             s[vl]:=1;     
             dist[vl]:=dist[nodulet]+1;     
             idist[dist[vl]]:=vl;     
             if marc[vl]=1 then    
               while nod[vl]<>nil do    
                 begin    
                   qout(nod[vl],valo);     
                   rez:=dist[vl]-valo;     
                   if rez>0 then qin(a[vl],idist[rez])  
                            else qin(a[vl],0);  
                 end;  
             df(vl);     
           end;  
       end;  
   end;  
   begin  
     assign(fi,'stramosi.in'); reset(fi);  
     assign(fo,'stramosi.out'); rewrite(fo);  
     read(fi,n,m);  
     ct:=0;  
     for i:=1 to n do  
       begin  
         read(fi,v);  
         if v=0 then  
           begin  
             inc(ct);  
             father[ct]:=i;  
           end  
        else  
         begin  
           qin(list[i],v);  
           qin(list[v],i);  
         end;  
       end;  
     for i:=1 to m do  
        begin  
          read(fi,varf[i],stramos[i]);  
          marc[varf[i]]:=1;  
          qin(nod[varf[i]],stramos[i]);  
        end;  
     for i:=1 to ct do  
       begin  
         dist[father[i]]:=1;  
         while (nod[father[i]]<>nil) do  
           begin  
             qout(nod[father[i]],vl);  
             qin(a[father[i]],0);  
           end;  
         idist[1]:=father[i];     
         df(father[i]);     
       end;     
     for i:=1 to m do    
       if a[varf[i]]<>nil then    
         begin    
           qout(a[varf[i]],vl);     
           writeln(fo,vl);     
         end;     
     close(fi);     
     close(fo);     
   end.