program p1039;// Use DP, but Memory Limit Exceeded.
// for this one program,
// i have got 35423 KB, 25635 KB, or even 17495 KB,
// but never 16384 KB...
// what a pity!!!

var
  g:array[1..6000,1..6000]of boolean;
  y:array[1..6000]of boolean;
  v:array[1..6000]of integer;
  tree,son:array[1..6000,0..6000]of word;
  f:array[1..6000,1..2]of longint;
  n,i,j,k,t,xx,yy,ans,p:longint;

function max(a,b:longint):longint;
  begin
    if a>b
      then max:=a else max:=b;
  end;

begin
  fillchar(g,sizeof(g),false);
  readln(n);
  for i:=1 to n do readln(v[i]);
  readln(xx,yy);
  while (xx>0) do
  begin
    g[xx,yy]:=true;
    g[yy,xx]:=true;
    readln(xx,yy);
  end;

  fillchar(y,sizeof(y),true);
  fillchar(tree,sizeof(tree),0);
  fillchar(son,sizeof(son),0);
  y[1]:=false; p:=1;
  tree[1,0]:=1;tree[1,1]:=1;

  while tree[p,0]>0 do
  begin
    for i:=1 to tree[p,0] do
      for j:=1 to n do
        if (y[j] and g[tree[p,i],j])
          then begin
            inc(tree[p+1,0]);
            tree[p+1,tree[p+1,0]]:=j;
            y[j]:=false;
            inc(son[tree[p,i],0]);
            son[tree[p,i],son[tree[p,i],0]]:=j;
          end;
    inc(p);
  end;

  for i:=p-1 downto 1 do
    for j:=1 to tree[i,0] do
    begin
      t:=tree[i,j];
      f[t,1]:=v[t];
      f[t,2]:=0;
      for k:=1 to son[t,0] do
      begin
        f[t,1]:=f[t,1]+f[son[t,k],2];
        f[t,2]:=f[t,2]+max(f[son[t,k],1],f[son[t,k],2]);
      end;
    end;
  ans:=max(f[1,1],f[1,2]);
  writeln(ans);
end.

Edited by author 22.12.2007 16:39

you don't need so big array as son or tree
array [1..n, 1..n] is too big.

all you need is several arrays [1..n]
for example you can store for each vertex
his parent, leftmost child and rightmost brother.
another way is to use lists of childs. sum of all lengths of
these lists will be N - 1, so it is O(n) memory, not n^2
the second way is better.
you can find "linked list" data structure, for example in google

type
  pnode = ^node;
  node = record
    x: integer;
    next: pnode;
  end;

procedure add(var p: pnode; x: integer);
var t: pnode;
begin
  new(t);
  t^.x := x;
  t^.next := p;
  p := t;
end;

var
  s, t: pnode;
  i: Integer;
begin
  s := nil;
  for i := 1 to 10 do add(s, i);
  t := s;
  while (t <> nil) do
  begin
    writeln(t^.x);
    t := t^.next;
  end;
  readln;
end.

Thanks a lot.

I can tell you the answer!
program rabidstorm1039;
const
  maxn=6000;
var
  pres:array[1..maxn]of boolean;{True if he can be president}
  now,child,pre:array[1..maxn]of word;
  yes,no:array[1..maxn]of longint;
  n,i,x,y:word;
  root:longint;
function max(a,b:longint):longint;
  begin
    if a>b then max:=a else max:=b;
  end;
procedure dfs(v:word);
  begin
    while now[v]>0 do begin
      dfs(child[now[v]]);
      inc(yes[v],no[child[now[v]]]);
      inc(no[v],max(yes[child[now[v]]],no[child[now[v]]]));
      now[v]:=pre[now[v]];
    end;
  end;
begin
  read(n);
  for i:=1 to n do
    read(yes[i]);
  fillchar(pres,sizeof(pres),1);
  root:=n*(n+1) div 2;
  for i:=1 to n-1 do begin
    read(x,y);
    child[i]:=x;
    pre[i]:=now[y];
    now[y]:=i;
    if pres[x] then begin
      dec(root,x);
      pres[x]:=false;
    end;
  end;

  dfs(root);

  writeln(max(yes[root],no[root]));
end.