Cod sursa(job #710106)

Utilizator ctlin04UAIC.VlasCatalin ctlin04 Data 8 martie 2012 23:37:22
Problema Cerere Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
Program cerere;
type lista=^celula;
      celula=record
              inf:longint;
              next:lista;
              end;
 var a,b,v,aux,z:array [0..100001] of longint;
    c:array [1..100001] of lista;
    r:lista;
    i,n,x,y,l,j:longint;
    b1,b2:array [1..1 shl 15] of char;
    fi,fo:text;
procedure dfs(k:longint);
 var r:lista;
begin
 r:=c[k];
 while r<>nil do begin
                 inc(l); aux[l]:=r^.inf; b[r^.inf]:=aux[l-a[r^.inf]];
                  dfs(r^.inf);
                  dec(l);
                   r:=r^.next;
                 end;
end;
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);
                   inc(z[y]);
                    new(r);
                   r^.inf:=y; r^.next:=c[x]; c[x]:=r;
                      end;
   for i:=1 to n do if z[i]=0 then begin l:=1; aux[l]:=i; dfs(i); break; 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.