с Делфи...
| Код |
Type tip_f = integer; matr = Array of Array of tip_f; mas = Array of integer;
Function Potok (s, t: integer; Var nf: integer; Var p, f: matr; Var o: mas): tip_f;
Var d, g, st: mas; mP: Array of tip_f; minP: tip_f;
a, c, i, ii, j, k, kk, n, r: integer; b: Boolean;
Function Shir: Boolean; // Поиск в ширину – 1-я фаза каждой итерации
begin j:=0; Repeat g[j]:=n; Inc(j) Until j = n; g[t]:=0;
Shir:= true; k:= 0; i:= 0; c:= 0; o[k]:= t; // Поиск начинается от стока t
Repeat ii:=k; Inc(c); // и развивается в сторону истока
Repeat j:=o[i]; r:=0; // Цикл работы с узлами одного яруса каркаса
Repeat If g[r] = n then // Ниже проверяется не насыщенность дуги или
If(p[r, j] > f [r, j]) or (f[j, r] > 0) then // наличие потока, если дуга обратная
begin Inc(k); o[k]:= r; g[r]:=c; If r = s then Exit end; // Успешный выход,
Inc(r) // когда исток s найден
Until r = n; Inc(i) // Конец рассмотрения узлов, смежных с узлом j
Until i > ii; // Завершение работы на одном ярусе каркаса
Until i > k; Shir:= false // Если i > k, очередь исчерпана, исток не достигнут
end; // Неуспех поиска – признак того, что максимальный поток построен
Procedure Glub; // Поиск в глубину – 2-я фаза каждой итерации
Procedure pp; // Шаг возврата по дуге
begin Dec(k); j:= r; If k < 0 then Exit; r:=st[k]; kk:=k+1;
If b then begin Inc(minP, d[kk]); If p[r, j] > 0 then Inc(f [r, j], minP)
Else {обратная дуга} Dec(f [j, r], minP) end
end;
begin minP:= MaxInt; k:= 0; mP[k]:= minP; // Начало тела блока Glub
i:= 0; d[0]:= 0; kk:= –1; st[k]:= s; r:= s; o[s]:=0; j:= –1; b:= false;
Repeat a:= 0;
Repeat Inc(j); If j = n then Break; // Поиск дуги для движения вперед
If g[j] < g[r] then begin a:= f [j, r]; If a = 0 then a:= p[r, j] – f [r, j] end
Until a > 0; If j = n then begin pp; Continue end; // Возврат – дуга не найдена
If k < kk then // Первый шаг вперед после возвратов
begin i:= o[r]; If b then Inc(d[k], minP); minP:= mP[k] – d[k]; b:= false end;
Inc(k); st[k]:= j; d[k]:= 0; r:= j;
If a < minP then begin minP:= a; i:= k end; // Новое «узкое» место
If j = t then {шаги возврата от конца УЦ}
begin b:=true; Repeat pp Until k < i end
Else begin mP[k]:= minP; o[j]:= i; j:= –1 end; // Регистрация «узкого» места
Until k < 0
end;
begin n:= Length(f); SetLength(o, n); // Тело блока Potok; результат – поток mf
SetLength(g, n); SetLength(d, n); SetLength(mP, n); SetLength(st, n);
While Shir do Glub; // Итерационный цикл построения максимального потока
nf:= k+1; minP:= 0; For j:= 0 to n–1 do Inc(minP, f [s, j]) // Вычисление потока
Result:= minP
end;
Procedure TForm1.Button1Click(Sender: TObject);
Const pc: Array [0..11, 0..11] of tip_f =
((0, 4, 0, 7, 2, 0, 0, 0, 0, 0, 0, 0), {a}
(0, 0, 0, 0, 0, 7, 0, 0, 3, 0, 0, 0), {b}
(0, 0, 0, 0, 0, 8, 2, 0, 0, 0, 0, 0), {c}
(0, 0, 0, 0, 8, 0, 0, 2, 0, 0, 0, 0), {d}
(0, 0, 0, 0, 0, 0, 0, 6, 0, 6, 0, 0), {e}
(5, 0, 0, 0, 0, 0,11, 0, 0, 0, 0, 0), {f}
(0, 0, 0, 0, 0, 0, 0, 0, 0,12, 0, 2), {g}
(0, 0, 0, 0, 0, 0, 0, 0, 3, 0, 0, 9), {h}
(0, 0, 0, 0, 0, 3, 0, 0, 0, 8, 0, 3), {i}
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,15), {j}
(6,10,14, 0, 0, 0, 0, 0, 0, 0, 0, 0), {s}
(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)); {t}
Var i, j, nf, n: integer; mf: tip_f; {a b c d e f g h i j s t}
f, p: matr; o: mas;
begin n:= 12; SetLength (f, n, n); SetLength (p, n, n);
For i:= 0 to n–1 do For j:=0 to n–1 do begin p[i, j]:= pc[i, j]; f[i, j]:= 0 end;
Memo1.text:= ‘Поток = ’ + IntToStr(Potok(10, 11, nf, p, f, o)) end;
|
|