Новичок
Профиль
Группа: Участник
Сообщений: 10
Регистрация: 2.5.2005
Репутация: нет Всего: нет
|
с Делфи... | Код | 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;
|
|