Cod sursa(job #133835)

Utilizator Pepelea_FlaviuFlaviu Pepelea Pepelea_Flaviu Data 9 februarie 2008 20:43:13
Problema Stramosi Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.52 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.