ditch_dinic_obj_非递归.pas

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

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

type
  TIndex = Longint;
  PAdjLst = ^TAdjLst;
  TAdjLst = record
    v: TIndex;
    cf: Longint;
    fore, rev: PAdjLst;
  end;
  TNetwork = object
  public
    maxf: Longint;
    procedure Init(Fs, Ft: TIndex);
    procedure Augment();
  private
    pre, cur, mina: array[1..MaxV] of PAdjLst;
    d: array[1..MaxV] of TIndex;
    Q: array[1..MaxV] of TIndex;
    cl, op: TIndex;
    s, t: TIndex;
    incf: Longint;
    function CanAugment(): Boolean;
  end;

var
  nbr: array[1..MaxV] of PAdjLst;
  Network: TNetwork;
  SizN, SizM: TIndex;

procedure TNetwork.Init(Fs, Ft: TIndex);
begin
  s := Fs; t := Ft;
  new(mina[s]); mina[s]^.cf := High(Longint);
  new(mina[s]^.rev); mina[s]^.rev^.v := s;
  maxf := 0;
end;

function TNetwork.CanAugment(): Boolean;
var
  u: TIndex;
  p: PAdjLst;
begin
  fillchar(d, SizeOf(d), $7F);
  d[t] := 0;
  cl := 0; op := 1; Q[1] := t;
  while ( cl < op ) do begin
    inc(cl); u := Q[cl]; 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 = s ) then exit(true);
        inc(op); Q[op] := p^.v;
      end;
      p := p^.fore;
    end;
  end;
  exit(false);
end;
procedure TNetwork.Augment();
var
  u: TIndex;
begin
  while ( CanAugment ) do begin
    cur := nbr;
    u := s;
    repeat
      while ( cur[u] <> nil ) do
        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];
          u := cur[u]^.v;
          if ( u = t ) then begin
            incf := mina[u]^.cf;
            inc(maxf, incf);
            while ( u <> s ) do begin
              dec(pre[u]^.cf, incf); inc(pre[u]^.rev^.cf, incf);
              u := pre[u]^.rev^.v;
            end;
            u := mina[t]^.rev^.v;
          end;
        end else cur[u] := cur[u]^.fore;
      if ( u = s ) then break;
      u := pre[u]^.rev^.v;
      cur[u] := cur[u]^.fore;
    until ( false );
  end;
end;

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);
  for i := 1 to SizM do begin
    readln(u, v, cap);
    SerereArc(u, v, cap);
  end;
  close(input);
end;

procedure Main();
begin
  assign(output, FILO); rewrite(output);
  Network.Init(1, SizN);
  with Network do begin
    maxf := 0;
    Augment;
    writeln(maxf);
  end;
  close(output);
end;

begin
  Init;
  Main;
end.