Cod sursa(job #44150)

Utilizator floringh06Florin Ghesu floringh06 Data 30 martie 2007 21:57:23
Problema Asmax Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.67 kb
const MAXN=16000;
  filein='asmax.in';
  fileout='asmax.out';
type longarray=array[1..MAXN] of longint;
     plongarray=^longarray;
     plist=^list;
     list=record next:integer; urm:plist; end;
var  edge:array[1..MAXN] of plist;
     v,max,tata:plongarray;
     n:integer;

 procedure readinput;
   var i,j,k:integer;
    aux:plist;
      begin
       assign(input,filein);
       reset(input);
       read(n);
       new(v);
       for i:=1 to n do
        begin
        read(v^[i]);
        edge[i]:=nil;
        end;
       for k:=1 to n-1 do
        begin
        read(i,j);
        new(aux);
        aux^.next:=j;
        aux^.urm:=edge[i];
        edge[i]:=aux;
        new(aux);
        aux^.next:=i;
        aux^.urm:=edge[j];
        edge[j]:=aux;
        end;
      close(input);
    end;

 procedure compute(nod:integer);
   var aa:plist;
        i:integer;
   begin
     max^[nod]:=v^[nod];
     aa:=edge[nod];
      while (aa<>nil) do
      begin
       i:=aa^.next;
       if (i<>tata^[nod]) then
       begin
        tata^[i]:=nod;
        compute(i);
        if (max^[i]>0) then
        max^[nod]:=max^[nod]+max^[i];
       end;
      aa:=aa^.urm;
      end;
   end;

  procedure print;
   var maxim:longint;
           i:integer;
   begin
     maxim:=max^[1];
     for i:=2 to n do
      if (max^[i]>maxim) then
         maxim:=max^[i];
     assign(output,fileout);
     rewrite(output);
     if maxim <5000 then writeln(maxim);
     close(output);
   end;

begin
  readinput;
  new(tata);
  fillchar(tata^,sizeof(longarray),0);
  new(max);
  fillchar(max^,sizeof(longarray),0);
  compute(1);
  print;
end.