Cod sursa(job #140363)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 21 februarie 2008 19:58:46
Problema Cerere Scor 65
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.35 kb
type adress=^nod;
     nod = record
     inf:longint;
     adr:adress;
     end;

var n,rad:longint;
    cs,st,rez:array[1..100002] of longint;
    v:array[1..100002] of adress;

procedure citire;
        var f:text;
            x,y,i:longint;
            q:adress;
        begin
        assign(f,'cerere.in'); reset(f);
        read(f,n);
        for i:=1 to n do v[i]:=nil;
        for i:=1 to n do read(f,cs[i]);
        for i:=1 to n-1 do
            begin
            read(f,x,y);
            new(q);
             q^.inf:=y;
             q^.adr:=v[x];
             v[x]:=q;
            end;
        close(f);
        end;

procedure df(k,niv:longint);
        var q:adress;
        begin
        st[niv]:=k;
        if (cs[k]=0) then
           rez[k]:=0
        else
                rez[k]:=rez[st[niv-cs[k]]]+1;
        q:=v[k];
        while (q<>nil) do
         begin
         df(q^.inf,niv+1);
         q:=q^.adr;
         end;
        end;

procedure scriere;
        var i:longint;
            f:text;
            q:adress;
        begin
        assign(f,'cerere.out');
        rewrite(f);
        for i:=1 to n do write(f,rez[i],' ');

        close(f);

        end;


begin
citire;
for rad:=1 to  n do
 if cs[rad]=0 then
        begin
        df(rad,1);
        break;
        end;
scriere;
end.