网络流习题



type
  nettype=record
     c,f:longint;
  end;
  notetype=record
    l,p:longint;
  end;
var
  lt:array[0..20] of notetype;
  g:array[0..20,0..20] of nettype;
  n,s,t,i,j,del,max:longint;
  success:boolean;

function find:longint;
var
  i:longint;
begin
  i:=1;
  while (i<=n) and not((lt[i].l<>0) and (lt[i].p=0)) do inc(i);
  if i>n then find:=0
  else find:=i;
end;

function ford(var a:longint):boolean;
var
  i,j,m,x:longint;
begin
  ford:=true;
  fillchar(lt,sizeof(lt),0);
  lt[s].l:=s;
  repeat
    i:=find;
    if i=0 then exit;
    for j:=1 to n do
      if (lt[j].l=0) and ((g[i,j].c<>0) or (g[j,i].c<>0)) then begin
        if (g[i,j].f<g[i,j].c) then lt[j].l:=i;
        if g[j,i].f>0 then lt[j].l:=-i;
      end;
    lt[i].p:=1;
  until lt[t].l<>0;
  m:=t;a:=maxlongint;
  repeat
    j:=m;
    m:=abs(lt[j].l);
    if lt[j].l<0 then x:=g[j,m].f;
    if lt[j].l>0 then x:=g[m,j].c-g[m,j].f;
    if x<a then a:=x;
  until m=s;
  ford:=false;
end;

procedure change(a:longint);
var
  m,j:longint;
begin
  m:=t;
  repeat
    j:=m;m:=abs(lt[j].l);
    if lt[j].l<0 then g[j,m].f:=g[j,m].f-a;
    if lt[j].l>0 then g[m,j].f:=g[m,j].f+a;
  until m=s;
end;

begin
  readln(n);
  fillchar(g,sizeof(g),0);
  fillchar(lt,sizeof(lt),0);
  for i:=1 to n do
    for j:=1 to n do read(g[i,j].c);
  s:=1;t:=n;
  repeat
    success:=ford(del);
    if success then begin
      max:=0;
      for i:=1 to n do begin
        max:=max+g[i,t].f;
        for j:=1 to n do
          if g[i,j].f<>0 then writeln(i,'->',j,' ',g[i,j].f)
      end;
      writeln(max);
    end
    else change(del);
  until success;
  readln;
end.