JLOI2010 冠军调查 最小割

var
  b,f:array[0..100000] of longint;
  s,t,i,j,n,m,x,y:longint;
  l,h:array[0..1000]of longint;
  a:array[0..1000,0..1000]of longint;
procedure bfs;
var i,head,tail,x,y:longint;
begin
  fillchar(b,sizeof(b),0);
  fillchar(h,sizeof(h),$7f);
  h[t]:=0;
  head:=1; tail:=1; b[1]:=t;
  while head<=tail do
    begin
      x:=b[head];
      for i:=1 to n do
        if (a[i,x]>0) and (h[i]>=n) then
          begin
            inc(tail);
            b[tail]:=i;
            h[i]:=h[x]+1;
          end;
      inc(head);
    end;
end;
function dfs(now,inl:longint):longint;
var i,outl:longint;
begin
  if now=t then exit(inl);
  dfs:=0;
  for i:=l[now]+1 to n do
    if (l[i]<n) and (a[now,i]>0) and (h[now]=h[i]+1) then
      begin
        if a[now,i]>inl then outl:=dfs(i,inl)
                        else outl:=dfs(i,a[now,i]);
        inl:=inl-outl;
        dfs:=dfs+outl;
        a[now,i]:=a[now,i]-outl;
        a[i,now]:=a[i,now]+outl;
        if inl=0 then break;
        inc(l[now]);
      end;
end;
function dinic:longint;
var sum:longint;
begin
    sum:=0;
    while h[s]<n do
    begin
        fillchar(l,sizeof(l),0);
        sum:=sum+dfs(s,maxlongint);
        bfs;
    end;
    exit(sum);
end;
begin
  readln(n,m);
  for i:=1 to n do read(f[i]);
  for i:=1 to n do
    if f[i]=0 then
      a[1,i+1]:=1 else a[i+1,n+2]:=1;
  for i:=1 to m do
    begin
      readln(x,y);
      a[x+1,y+1]:=1;
      a[y+1,x+1]:=1;
    end;
  s:=1;
  t:=n+2;
  n:=n+2;
  writeln(dinic);
end.
原文地址:https://www.cnblogs.com/rpSebastian/p/4298501.html