Cod sursa(job #5115)

Utilizator fogabFodor Gabor fogab Data 10 ianuarie 2007 18:29:51
Problema Cerere Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.27 kb
type pc = ^c;
     c = record
         s:longint;
         next:pc;
         end;
var f:text;
    i,j,n,gy:longint;
    me:pc;
    kk,t,sol:array[1..100000] of longint;
    r:array[1..100000] of byte;
    a,a2:array[1..100000] of pc;

procedure run(m,k,ind:longint);
var go:pc;
begin
t[ind]:=m;
if kk[m]=0 then sol[m]:=0
           else sol[m]:=sol[t[ind-kk[m]]]+1;
new(go);
go:=a[m];
while go^.next<>nil do begin
                       go:=go^.next;
                       run(go^.s,k+1,ind+1);
                       end;
end;

begin
assign(f,'cerere.in');
reset(f);
readln(f,n);
for i:=1 to n do begin
                 new(a[i]);
                 a[i]^.next:=nil;
                 new(a2[i]);
                 a2[i]^.next:=a[i];
                 end;
for i:=1 to n do read(f,kk[i]);
for i:=1 to n-1 do begin
                   readln(f,j,gy);
                   r[gy]:=1;
                   new(me);
                   me^.s:=gy;
                   me^.next:=nil;
                   a2[j]^.next^.next:=me;
                   a2[j]^.next:=me;
                   end;
close(f);

for i:=1 to n-1 do if r[i]=0 then gy:=i;
kk[gy]:=0;
sol[gy]:=0;
run(gy,0,1);
assign(f,'cerere.out');
rewrite(f);
for i:=1 to n do write(f,sol[i],' ');
close(f);
end.