Cod sursa(job #10938)

Utilizator fogabFodor Gabor fogab Data 29 ianuarie 2007 22:51:16
Problema Asmax Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.51 kb
type pc = ^c;
     c = record
         k:integer;
         urm:pc;
         end;
var f:text;
    no:array[0..12000] of byte;
    a:array[1..12000] of integer;
    b:array[1..12000] of longint;
    d,dl:array[1..12000] of pc;
    max:longint;
    h:pc;
    i,n,x,y:integer;

procedure go(x:integer);
var t:pc;
    s:longint;
begin
t:=d[x];
b[x]:=a[x];
no[x]:=1;
while t<>nil do begin
                     if no[t^.k]=0 then
                        begin
                        go(t^.k);
                        if b[t^.k]>0 then b[x]:=b[x]+b[t^.k];
                        end;
                     t:=t^.urm;
                     end;
end;

begin
no[0]:=1;
assign(f,'asmax.in');
reset(f);
readln(f,n);
for i:=1 to n do begin
                 read(f,a[i]);
                 new(d[i]);
                 new(dl[i]);
                 d[i]^.urm:=nil;
                 d[i]^.k:=0;
                 dl[i]^.urm:=d[i];
                 end;
for i:=1 to n-1 do begin
                   readln(f,x,y);
                   new(h);
                   h^.k:=y;
                   h^.urm:=nil;
                   dl[x]^.urm^.urm:=h;
                   dl[x]^.urm:=h;
                   new(h);
                   h^.k:=x;
                   h^.urm:=nil;
                   dl[y]^.urm^.urm:=h;
                   dl[y]^.urm:=h;
                   end;
close(f);
go(1);
max:=b[1];
for i:=1 to n do
   if max<b[i] then max:=b[i];
assign(f,'asmax.out');
rewrite(f);
writeln(f,max);
close(f);
end.