Раздел «Алгоритмы».MaxFlowPushRelablePAS:

Поиск максимального потока методом проталкивания предпотока на Pascal

//(C) Igor Kvasov
{поиск максимального потока методом проталкивания предпотока
в его реализации "поднять-и-в начало"}
var
  n,m,i,u,v,w,nL,head,vin,vout,oldh,ans:longint;
  f,c,e:array[1..100,1..100]of longint;
  ne,cur,next,prev,L,s,h:array[1..100]of longint;

procedure Push(u,v:longint);
var
  d:longint;

begin
  d:=c[u,v]-f[u,v];
  if d>s[u] then d:=s[u];
  s[u]:=s[u]-d; s[v]:=s[v]+d;
  f[u,v]:=f[u,v]+d;
  f[v,u]:=-f[u,v];
end;

procedure Lift(u:longint);
var
  v:longint;

begin
  h[u]:=2*n;
  for v:=1 to n do if (c[u,v]-f[u,v]>0)and(h[v]<h[u]) then h[u]:=h[v];
  inc(h[u]);
end;

procedure Discharge(u:longint);
begin
  while s[u]>0 do begin
    v:=e[u,cur[u]];
    if v=0 then begin
      Lift(u); cur[u]:=1;
    end else if (c[u,v]-f[u,v]>0)and(h[u]=h[v]+1) then Push(u,v)
             else inc(cur[u]);
  end;
end;

begin
  read(n,m,vin,vout);
  for i:=1 to m do begin
    read(u,v,w);
    if c[v,u]=0 then begin
      inc(ne[u]); e[u,ne[u]]:=v;
      inc(ne[v]); e[v,ne[v]]:=u;
    end;
    c[u,v]:=w;
  end;
  close(input);
  h[vin]:=n;
  for v:=1 to n do begin
    if c[vin,v]>0 then begin
      f[vin,v]:=c[vin,v]; f[v,vin]:=-c[vin,v];
      s[v]:=s[v]+c[vin,v];
    end;
    if (v<>vin)and(v<>vout) then begin
      cur[v]:=1;
      inc(nL); L[nL]:=v;
    end;
  end;
  for i:=1 to nL do begin
    prev[i]:=i-1; next[i]:=i+1;
  end;
  if nL<>0 then begin
    next[nL]:=0;
    head:=1; i:=head;
  end else i:=0;
  while i>0 do begin
    u:=L[i];
    oldh:=h[u];
    Discharge(u);
    if (h[u]<>oldh)and(i<>head) then begin
      if next[i]<>0 then prev[next[i]]:=prev[i];
      next[prev[i]]:=next[i];
      next[i]:=head;
      prev[i]:=0; prev[head]:=i;
      head:=i;
    end;
    i:=next[i];
  end;
  ans:=0;
  for u:=1 to n do ans:=ans+f[vin,u];
  write(ans);
end.

-- IgorKvasov? - 28 Dec 2004

AlgorithmClasifyForm
Type: Код
Scope: Графы
Strategy:  
Complexity: Low