Cod sursa(job #129899)

Utilizator alexrusuRusu Alexandru alexrusu Data 30 ianuarie 2008 16:22:03
Problema Stramosi Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.63 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.