3 Решение задачи о максимальном потоке аналитическим методом
Рисунок 9
РЕШЕНИЕ: С помощью алгоритма Форда-Фалкерсона найдем наибольший поток из 1 в 8.
Шаг 1. Выбираем произвольный поток, например, 1-2-5-8. Его пропускная способность равна минимальной из всех пропускных способностей входящих в него дуг, то есть 1. Уменьшаем пропускные способности дуг этого потока на 1, насыщенные дуги 2-5 и 5-8 вычеркиваем.
Шаг 2. Выбираем произвольный поток, например, 0-4-7-8. Его пропускная способность равна минимальной из всех пропускных способностей входящих в него дуг, то есть 1. Уменьшаем пропускные способности дуг этого потока на 1, насыщенную дугу 7-8 вычеркиваем.
Рисунок 10
Шаг 3. Выбираем произвольный поток 1-3-4-7-6-8. Его пропускная способность равна минимальной из всех пропускных способностей входящих в него дуг, то есть 1. Уменьшаем пропускные способности дуг этого потока на 1, насыщенные дуги 3-4, 4-7, 6-8вычеркиваем.
Рисунок 11
Поток в сети равен: 1+1+1=1+1+1=3.
Насыщенные дуги: 2-5, 5-8 , 7-8 , 3-4, 4-7, 6-8.
Начинаем расстановку пометок. Начальная вершина (источник) 1 имеет пометку 0.
4 Алгоритм программы
пуск
Сток
помечен?
S
= вершина с меткой i+1 k=k+1
Ввод
матрицы
i
= i-1
Выделение
пути из истока в сток
D
= Поиск ребра с минимальной пропускной
способностью
Увеличение
потока по всем ребрам из истока в сток
F
= F+D
Обход
вершин, смежных с S
i=0 S
= исток F
= 0
существует
вершина с пометкой k+1
Текст программы имеет следующий вид:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, Grids;
type
TForm1 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Button1: TButton;
StringGrid1: TStringGrid;
Label3: TLabel;
Edit3: TEdit;
Label4: TLabel;
Edit4: TEdit;
Memo1: TMemo;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Edit2Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
MaxV=1000;
MaxE=30000;
free_=0;
bisy_ = 1;
Great=MaxLongint;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Edit2Change(Sender: TObject);
var st,i,u: integer;
begin
st:=StrToInt(edit2.Text);
StringGrid1.RowCount:=st+1;
u:=StrToInt(edit2.Text);
for i:=1 to u do
StringGrid1.Cells[0, i] :=IntToStr(i) ;
end;
procedure TForm1.FormCreate(Sender: TObject);
var i,u: integer;
begin
StringGrid1.Cells[0, 0] := 'Ребро';
StringGrid1.Cells[1, 0] := 'x';
StringGrid1.Cells[2, 0] := 'y';
StringGrid1.Cells[3, 0] := 'z'; //вес ребра
end;
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
n, m, last, s, t, x, y, z: longint;
v,l: array[1..MaxV] of longint;
adj, next, c, f: array[1..MaxE] of longint;
found: boolean;
MaxPOTOK: longint;
prev: array [1..MaxV] of longint;
Marked: array [1..MaxV] of byte;
que,poz: array [1..MaxE] of longint;
qb,qe: longint;
procedure Init(n,m: longint);
var
i: longint;
begin
for i:=1 to n do
begin
v[i] := free_;
l[i] := free_;
end;
for i:=1 to 2*m do
begin
adj[i] := free_;
c[i] := free_;
next[i] := free_;
f[i] := free_;
end;
last := 0;
end;
procedure AddEdge(x,y,z: longint);
begin
inc(last);
adj[last] := y;
c[last] := z;
if v[x] = free_ then
begin
v[x] := last;
end else
begin
next[l[x]] := last;
end;
l[x] := last;
end;
procedure ErrorMes;
begin
ShowMessage('Неверно введены входные данные!');
exit
end;
procedure Put(x: longint);
begin
inc(qe);
que[qe]:=x;
Marked[x]:=bisy_;
prev[x]:=que[qb];
end;
procedure InitQue(x: longint);
var
i: longint;
begin
for i:=1 to 2*m do
begin
Marked[i]:=free_;
poz[i]:=0;
end;
qb:=1;
qe:=1;
que[qe] := x;
Marked[x] := bisy_;
end;
procedure FindWay;
var
x,Min,cf: longint;
begin
InitQue(s);
while (qb<=qe)and(Marked[t]<>bisy_) do
begin
x:=v[que[qb]];
while adj[x]<>free_ do
begin
if (Marked[adj[x]]<>bisy_)and(c[x]-f[x]>0) then
begin
Put(adj[x]);
poz[adj[x]]:=x;
end;
x:=next[x];
end;
inc(qb);
end;
if Marked[t]=free_ Then
begin
Found:=False;
Exit;
end;
Min:=Great;
x:=t;
while prev[x]<>free_ do
begin
cf:=c[poz[x]]-f[poz[x]]{!};
if cf<Min Then Min:=cf;
x:=prev[x];
end;
x:=t;
while prev[x]<>free_ do
begin
f[poz[x]]:=f[poz[x]]+Min;
if c[poz[x]]<>free_ then
f[poz[x]+1]:=-f[poz[x]]
else f[poz[x]-1]:=-f[poz[x]];
x:=prev[x];
end;
end;
begin
n := StrToIntDef(Edit1.Text, 0);
//Количество ребер
m := StrToIntDef(Edit2.Text, 0);
if (n = 0) or (m = 0) then ErrorMes;
Init(n,m);
for i := 1 to m do
begin
x := StrToIntDef(StringGrid1.Cells[1, i],0);
y := StrToIntDef(StringGrid1.Cells[2, i], 0);
z := StrToIntDef(StringGrid1.Cells[3, i], 0);
if (x <= 0) or (y <= 0) or (z <= 0) then ErrorMes;
AddEdge(x,y,z);
AddEdge(y,x,0);
end;
s := StrToIntDef(Edit3.Text, 0); // Источник
t := StrToIntDef(Edit4.Text, 0); // Сток
if (s > n) or (s <= 0) or (t > n) or (t <= 0) then ErrorMes;
found:=true;
while found do FindWay;
MaxPOTOK := 0;
x := v[s];
while x <> free_ do
begin
if f[x] > 0 then
MaxPOTOK := MaxPotok + f[x];
x:=next[x];
end;
Memo1.Lines.Clear;
Memo1.Lines.Add('Максимальный поток в заданном графе равен: '+ IntToStr(MaxPotok))
end;
end.