Cod sursa(job #129359)

Utilizator Pepelea_FlaviuFlaviu Pepelea Pepelea_Flaviu Data 29 ianuarie 2008 09:08:08
Problema Stramosi Scor 90
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.27 kb
type pelem=^elem;
     elem=record
       info:longint;   
       next:pelem;   
     end;   
var fi,fo:text;   
    s,father,dist,idist,stramos,varf:array[1..300010]of longint;
    nod,list,a:array[1..300010]of pelem;
    marc:array[1..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,mm: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.