sap.pas

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

{
ID: reiny3
PROG: ditch
LANG: PASCAL
}
uses math;

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, cur, mina: array[1..MaxV] of PAdjLst;
  g: array[1..MaxV - 1] of TIndex;
  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;
  u: TIndex;
  p: PAdjLst;
  procedure InitFlow();
  begin
    fillchar(g, SizeOf(g), 0);
    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;
          inc(g[d[p^.v]]);
          inc(tl); Q[tl] := p^.v;
        end;
        p := p^.fore;
      end;
    end;
  end;
  procedure Augment();
  begin
    incf := mina[vt]^.cf;
    inc(maxf, incf);
    u := vt;
    while ( u <> vs ) do begin
      dec(pre[u]^.cf, incf); inc(pre[u]^.rev^.cf, incf);
      u := pre[u]^.rev^.v;
    end;
    u := mina[vt]^.rev^.v;
  end;
  procedure Retreat();
  begin
    dec(g[d[u]]);
    d[u] := SizV;
    p := nbr[u];
    while ( p <> nil ) do begin
      if ( (p^.cf > 0) and (d[p^.v] + 1 < d[u]) ) then begin
        d[u] := d[p^.v] + 1;
        cur[u] := p;
      end;
      p := p^.fore;
    end;
    inc(g[d[u]]);
  end;
begin
  maxf := 0;
  new(mina[vs]); mina[vs]^.cf := INF;
  InitFlow;
  cur := nbr;
  u := vs;
  while ( d[vs] < SizV ) do begin
    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 = vt ) then Augment;
      end else cur[u] := cur[u]^.fore;
    if ( g[d[u]] = 1 ) then break;
    Retreat;
    if ( u <> vs ) then u := pre[u]^.rev^.v;
  end;
  exit(maxf);
end;

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

begin
  Init;
  Main;
end.