Cod sursa(job #142988)

Utilizator belgun_adrianBelgun Dimitri Adrian belgun_adrian Data 25 februarie 2008 19:02:23
Problema Asmax Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.52 kb
//asmax

type adress = ^nod;
     nod = record
        inf:integer;
        adr:adress;
     end;


var n:integer;
    u:array[1..16000] of byte;
    v:array[1..16000] of integer;
    x:array[1..16000] of longint;
    p:array[1..16000] of adress;
    max:longint;

procedure citire;
        var f:text;
            i,a,b:integer;
            q:adress;
        begin
        assign(f,'asmax.in');
        reset(f);
          readln(f,n);
          for i:=1 to n do
               read(f,v[i]);
          readln(f);
          for i:=1 to n-1 do
              begin
              readln(f,a,b);
              new(q);
              q^.inf:=a;
              q^.adr:=p[b];
              p[b]:=q;
              new(q);
              q^.inf:=b;
              q^.adr:=p[a];
              p[a]:=q;
              end;
        close(f);
        end;


procedure df(k:integer);
        var q:adress;
            sum:longint;
        begin
        sum:=v[k];
        u[k]:=1;
        q:=p[k];
        while (q<>nil) do
         begin
         if u[q^.inf]=0 then
            begin
            df(q^.inf);
            if (x[q^.inf]>0) then
               sum:=sum+x[q^.inf];
            end;
         q:=q^.adr;
         end;
        x[k]:=sum;
        if max<sum then max:=sum;
        end;

procedure scrie;
        var f:text;
        begin
        assign(f,'asmax.out'); rewrite(f);
         writeln(f,max);
        close(f);
        end;

begin
citire;
max:=-20000000;
df(1);
scrie;
end.