Cod sursa(job #140361)

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

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

procedure citire;
        var f:text;
            ii,jj,i:longint;
            q:adress;
        begin
        assign(f,'cerere.in'); reset(f);
        readln(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
            readln(f,ii,jj);
            t[jj]:=ii;
            new(q);
             q^.inf:=jj;
             q^.adr:=v[ii];
             v[ii]:=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.