Cod sursa(job #1200520)

Utilizator vasica38Vasile Catana vasica38 Data 22 iunie 2014 18:10:55
Problema Asmax Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.05 kb
program
 p1;
type lista=^celula;
   celula=record
   info:integer;
   urm:lista;
        end;
var n,i,j,u,s,x,y,max:longint;
    f,g:text;
    a:array[0..20000] of lista;
    viz:array[0..20000] of 0..1;
    sum:array[0..20000] of longint;
    v:lista;
procedure dfs(nod:integer);
var r:lista;
begin
viz[nod]:=1;
r:=a[nod];
while r<> nil do begin
        if (viz[r^.info]=0) then begin
                dfs(r^.info);
                if sum[r^.info]>0 then sum[nod]:=sum[nod]+sum[r^.info];
                        end;
        r:=r^.urm;
                end;
end;
begin
assign(F,'asmax.in');reset(F);
assign(G,'asmax.out');rewrite(G);
readln(f,n);
for i:=1 to n do read(f,sum[i]);
readln(F);
for i:=1 to n do begin
        readln(f,x,y);
        new(v);
        v^.info:=y;
        v^.urm:=a[x];
        a[x]:=v;
        new(V);
        v^.info:=x;
        v^.urm:=a[y];
        a[y]:=v;
        end;

dfs(1);
max:=sum[1];
for i:=1 to n do
        if sum[i]>max then max:=sum[i];
writeln(g,max);
close(f);
close(G);
end.