Cod sursa(job #710085)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 8 martie 2012 22:37:43
Problema Cerere Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 0.82 kb
Program cerere;
 var a,b,v,c:array [1..100001] of longint;
    i,n,x,y,l,j:longint;
    b1,b2:array [1..1 shl 15] of char;
    fi,fo:text;
procedure solve(k:longint);
 begin
  if (v[b[k]]=0) and (a[b[k]]>0) then solve(b[k])
                                  else l:=v[b[k]];
   inc(l); v[k]:=l;
end;
begin
 assign(fi,'cerere.in');
  assign(fo,'cerere.out');
 settextbuf(fi,b1); settextbuf(fo,b2);
 reset(fi); rewrite(fo);
 readln(fi,n);
  for i:=1 to n do read(fi,a[i]); readln(fi);
 for i:=1 to n-1 do begin readln(fi,x,y); b[y]:=x; end;
 { for i:=1 to n do begin
                   x:=i;
                    for j:=1 to a[i] do x:=c[x];
                   b[i]:=x;
                   end;}
  for i:=1 to n do
   if a[i]>0 then begin l:=0; solve(i); end;
  for i:=1 to n do write(fo,v[i],' ');
 close(fo);
end.