网络流算法模板

浏览数：32 / 时间：2015年06月08日

通过USACO草地排水学习了一下网络流，终于写好了几个模板。

最大流

BFS求增广路径

简述：通过BFS在网络中找出一条最短增广路径并修改流量（前向弧加可改进量X，后向弧则减去X），当不存在增广路径时得出最大流，时间效率O(nm^2)。

{
ID: qty1272
PROG: ditch
LANG: PASCAL
}
program ditch;
var
  c,f:array[0..200,0..200]of longint;
  path,u:array[0..200]of longint;
  n,i,m,x,y,z,s,t,max:longint;
procedure change(a:longint);
var i,w:longint;
begin
  w:=t;
  repeat
     i:=w; w:=abs(path[i]);
     if path[i]<0 then f[i,w]:=f[i,w]-a;
     if path[i]>0 then f[w,i]:=f[w,i]+a;
  until w=s;
end;
function find:longint;
var i:longint;
begin
  i:=1;
  while (i<=n)and not((path[i]<>0)and(u[i]=0)) do inc(i);
  if i>n then find:=0 else find:=i;
end;
function ford(var a:longint):boolean;
var i,w:longint;
begin
  ford:=true;
  fillchar(path,sizeof(path),0);
  fillchar(u,sizeof(u),0);
  path[s]:=s;
  while path[t]=0 do
  begin
    x:=find;
    if x=0 then exit;
    for i:=1 to n do
      if (path[i]=0)and((c[x,i]<>0)or(c[i,x]<>0)) then
       begin
         if f[x,i]<c[x,i] then path[i]:=x;
         if f[i,x]>0 then path[i]:=-x;
       end;
    u[x]:=1;
  end;
  w:=t;   a:=maxlongint;
  repeat
     i:=w; w:=abs(path[i]);
     if path[i]<0 then x:=f[i,w];
     if path[i]>0 then x:=c[w,i]-f[w,i];
     if x<a then a:=x;
  until w=s;
  ford:=false;
end;
procedure shuchu;
var i:longint;
begin
  max:=0;
  for i:=1 to n do
   if f[i,t]<>0 then max:=max+f[i,t];
  writeln(max);
end;
procedure work;
var x:longint; g:boolean;
begin
  s:=1; t:=n;
  repeat
     g:=ford(x);
     if g then shuchu
      else change(x);
  until g;
end;
begin
  assign(input,‘ditch.in‘);
reset(input);
assign(output,‘ditch.out‘);
rewrite(output);
  readln(m,n);
  for i:=1 to m do
   begin
     readln(x,y,z);
     c[x,y]:=c[x,y]+z;
   end;
  work;
  close(input); close(output);
end.

View Code

dinic算法
简述：先BFS弄出层次图，在利用DFS找增广路径，时间效率O(n^2m)。

{
ID: qty1272
PROG: ditch
LANG: PASCAL
}
program ditch;
var
  c,f:array[0..200,0..200]of longint;
  team,d:array[0..200]of longint;
  g:array[0..200]of boolean;
  n,i,m,x,y,z,s,t,max,sum:longint;
function min(x,y:longint):longint;
begin
  if x<y then min:=x else min:=y;
end;
function bfs:boolean;
var i,u,head,tail:longint;
begin
  fillchar(g,sizeof(g),false);
  fillchar(d,sizeof(d),0);
  head:=0;  tail:=1;
  g[s]:=true; team[1]:=s;
  while head<tail do
   begin
     head:=head+1; u:=team[head];
     for i:=1 to n do
      if (not g[i])and(c[u,i]>f[u,i]) then
       begin
         d[i]:=d[u]+1; g[i]:=true;
         tail:=tail+1; team[tail]:=i;
       end;
   end;
  exit(g[t]);
end;
function dfs(x,flow:longint):longint;
var i,tmp,k:longint;
begin
  tmp:=flow;
  if x=t then exit(flow);
  for i:=1 to n do
   if (c[x,i]>f[x,i])and(d[x]+1=d[i]) then
    begin
      k:=dfs(i,min(c[x,i]-f[x,i],flow));
      f[x,i]:=f[x,i]+k;
      f[i,x]:=f[i,x]-k;
      flow:=flow-k;
    end;
   exit(tmp-flow);
end;
procedure work;
begin
  sum:=0;s:=1; t:=n;
  while bfs do
   begin
     inc(sum,dfs(s,maxlongint));
   end;
  writeln(sum);
end;
begin
  assign(input,‘ditch.in‘);
reset(input);
assign(output,‘ditch.out‘);
rewrite(output);
  readln(m,n);
  for i:=1 to m do
   begin
     readln(x,y,z);
     c[x,y]:=c[x,y]+z;
   end;
  work;
  close(input); close(output);
end.