poj 2987 Firing 最大权闭合子图

题目大意：一个公司有n个员工（里面包括董事长，经理，普通员工等等），现在遇见了金融危机，公司要开始裁员了，每个人对公司的价值不一样（可能为正可能为负），当你裁员一个员工时，这个员工他手下的员工必须一起裁掉，问你如何裁员能使公司得到的利益最大，而这种裁员方法必须得裁掉多少个员工。

分析：建立源点和汇点，若某员工权值大于0则从源点连一条容量为该权值的边，若某员工权值小于0则连一条到汇点容量为权值的绝对值的边，每对关系连一条容量无限的边，然后用正权值的和减去最大流就是第二问的答案。跑完最大流后源点能遍历到的点数为第二问的答案。

注意：有多组数据且ans要开int64或long long

代码：

var
  n,m,x,y,i,tot,e,s,t:longint;
  ans,sum:int64;
  fa,d,cur,last,num:array[0..6000] of longint;
  v:array[0..6000] of boolean;
  side:array[1..1000000] of record
    x,y,c,op,next:longint;
  end;

procedure add(x,y,c:longint);
begin
  inc(e);
  side[e].x:=x; side[e].y:=y; side[e].c:=c; side[e].op:=e+1;
  side[e].next:=last[x]; last[x]:=e;
  inc(e);
  side[e].x:=y; side[e].y:=x; side[e].c:=0; side[e].op:=e-1;
  side[e].next:=last[y]; last[y]:=e;
end;

procedure remark(x:longint);
var
  i,min:longint;
begin
  min:=n+1;
  cur[x]:=last[x];
  i:=cur[x];
  while i>0 do
    with side[i] do
    begin
      if (c>0)and(d[y]<min) then min:=d[y];
      i:=next;
    end;
  d[x]:=min+1;
end;

procedure change;
var
  i,min:longint;
begin
  min:=maxlongint;
  i:=t;
  while i<>s do
    with side[fa[i]] do
    begin
      if c<min then min:=c;
      i:=x;
    end;
  ans:=ans+min;
  i:=t;
  while i<>s do
    with side[fa[i]] do
    begin
      dec(c,min);
      inc(side[op].c,min);
      i:=x;
    end;
end;

procedure sap;
var
  i:longint;
begin
  fillchar(d,sizeof(d),0);
  fillchar(num,sizeof(num),0);
  for i:=s to t do
    cur[i]:=last[i];
  num[0]:=n+2;
  i:=s;
  while d[s]<n+2 do
  begin
    while cur[i]>0 do
      with side[cur[i]] do
        if (c>0)and(d[y]+1=d[x])
          then break
          else cur[i]:=next;
    if cur[i]=0
      then begin
             dec(num[d[i]]);
             if num[d[i]]=0 then break;
             remark(i);
             inc(num[d[i]]);
             if i<>s then i:=side[fa[i]].x;
           end
      else begin
             fa[side[cur[i]].y]:=cur[i];
             i:=side[cur[i]].y;
             if i=t then
             begin
               change;
               i:=s;
             end;
           end;
  end;
end;

procedure dfs(x:longint);
var
  i:longint;
begin
  v[x]:=false;
  i:=last[x];
  while i>0 do
    with side[i] do
    begin
      if (c>0)and(v[y]) then dfs(y);
      i:=next;
    end;
end;

begin
  while not eof do
  begin
    readln(n,m);
    s:=0;
    t:=n+1;
    e:=0;
    sum:=0;
    ans:=0;
    tot:=0;
    fillchar(last,sizeof(last),0);
    for i:=1 to n do
    begin
      readln(x);
      if x>0
        then begin
               sum:=sum+x;
               add(s,i,x);
             end
        else if x<0 then add(i,t,-x);
    end;
    for i:=1 to m do
    begin
      readln(x,y);
      add(x,y,maxlongint);
    end;
    sap;
    fillchar(v,sizeof(v),true);
    dfs(s);
    for i:=1 to n do
      if not v[i] then inc(tot);
    writeln(tot,' ',sum-ans);
  end;
end.