ditch_dinic.pas

求最大流的Dinic和SAP算法的实现

{
ID: reiny3
PROG: ditch
LANG: PASCAL
}
const
  FILI = 'ditch.in'; FILO = 'ditch.out';
  INF = Trunc(2E9);
  MaxN = 2000; MaxV = MaxN; MaxQ = MaxV;

type
  TIndex = Longint;
  PAdjLst = ^FAdjLst;
  FAdjLst = record
    v: TIndex;
    cf: Longint;
    fore, rev: PAdjLst;
  end;

var
  nbr, pre, mina, cur: array[1..MaxV] of PAdjLst;
  d: array[1..MaxV] of TIndex;
  Q: array[1..MaxQ] of TIndex;
  hd, tl: TIndex;
  SizN, SizM, SizV: TIndex;

procedure SerereArc(u, v: TIndex; cap: Longint);
var
  p: PAdjLst;
begin
  new(p); new(p^.rev);
  p^.v := v; p^.cf := cap;
  p^.fore := nbr[u]; nbr[u] := p;
  p^.rev^.rev := p; p := p^.rev;
  p^.v := u; p^.cf := 0;
  p^.fore := nbr[v]; nbr[v] := p;
end;

procedure Init();
var
  i: TIndex;
  u, v: TIndex;
  cap: Longint;
begin
  fillchar(nbr, SizeOf(nbr), 0);
  assign(input, FILI); reset(input);
  readln(SizM, SizN);
  SizV := SizN;
  for i := 1 to SizM do begin
    readln(u, v, cap);
    SerereArc(u, v, cap);
  end;
  close(input);
end;

function MaxFlow(vs, vt: TIndex): Longint;
var
  maxf, incf: Longint;
  function CanAugment(): Boolean;
  var
    u: TIndex;
    p: PAdjLst;
  begin
    fillchar(d, SizeOf(d), $7F);
    d[vt] := 0;
    hd := 0; tl := 1; Q[1] := vt;
    while ( hd < tl ) do begin
      inc(hd); u := Q[hd]; p := nbr[u];
      while ( p <> nil ) do begin
        if ( (p^.rev^.cf > 0) and (d[p^.v] > d[u] + 1) ) then begin
          d[p^.v] := d[u] + 1;
          if ( p^.v = vs ) then exit(true);
          inc(tl); Q[tl] := p^.v;
        end;
        p := p^.fore;
      end;
    end;
    exit(false);
  end;
  procedure DoAugment(u: TIndex);
  begin
    if ( u = vt ) then begin
      incf := mina[vt]^.cf;
      inc(maxf, incf);
      while ( u <> vs ) do begin
        dec(pre[u]^.cf, incf); inc(pre[u]^.rev^.cf, incf);
        u := pre[u]^.rev^.v;
      end;
      exit;
    end;
    while ( cur[u] <> nil ) do begin
      if ( (cur[u]^.cf > 0) and (d[u] = d[cur[u]^.v] + 1) ) then begin
        pre[cur[u]^.v] := cur[u];
        if ( mina[u]^.cf < cur[u]^.cf ) then mina[cur[u]^.v] := mina[u] else mina[cur[u]^.v] := cur[u];
        DoAugment(cur[u]^.v);
        if ( mina[u]^.cf = 0 ) then exit;
      end;
      cur[u] := cur[u]^.fore;
    end;
  end;
begin
  new(mina[vs]); mina[vs]^.cf := INF;
  maxf := 0;
  while ( CanAugment ) do begin
    cur := nbr;
    DoAugment(vs);
  end;
  exit(maxf);
end;

procedure Main();
begin
  assign(output, FILO); rewrite(output);
  writeln(MaxFlow(1, SizV));
  close(output);
end;

begin
  Init;
  Main;
end.