Подякувати Студентському архіву довільною сумою
Admin
26.02.2023 12:38
Дякуємо, що користуєтесь нашим архівом!
Лабораторна №3
Інформація про навчальний заклад
ВУЗ:
Національний університет Львівська політехніка
Інститут:
Не вказано
Факультет:
КН
Кафедра:
Кафедра СКС
Інформація про роботу
Рік:
2013
Тип роботи:
Лабораторна робота
Предмет:
Дискретна математика
Частина тексту файла (без зображень, графіків і формул):
Міністерство освіти і науки України
Національний університет „Львівська політехніка”
Кафедра СКС
Звіт
з лабораторної роботи № 3
з дисципліни: “Дискретна матетематика”
на тему: “ Знаходження максимальної пропускної спроможності графа”
Львів 2013
Мета: навчитися створювати програму яка обчислює максимальну прупускну спроможність графа
Теоретичні відомості
АЛГОРИТМ ФОРДА-ФАЛКЕРСОНА ДЛЯ ЗНАХОДЖЕННЯ ПОТОКУНАЙБІЛЬШОЇ ВЕЛЕЧИНИ
Розглянемо алгоритм Форда на прикладі графа зображеного на мал.1 .
Припустимо, у нас витік буде в 1 вузлі, а стік в 4 вузлі. Алгоритм можна розбити на три кроки:
1.Пошук довільного шляху з витоку до стоку. Якщо такого немає, то видаємо значення максимальної пропускної спроможності і алгоритм завершується.
2.Знаходження в обраному шляху ребра з мінімальною пропускною здатністю. Додаємо значення цього ребра до пропускної спроможності, яка на початку виконання алгоритму дорівнює 0.
3.Віднімання з усіх значень ребер шляху, значення мінімального ребра цього шляху. При цьому саме ребро звернутися в 0 і його вже не можна враховувати в подальшому. Далі продовжуємо з кроку 1.
На початку у нас пропускна здатність дорівнює 0 (P = 0). Припустимо, ми знайшли шлях з витоку 1 в стік 4 через вершини 2 і 3, тобто весь шлях можна записати як (1-2-3-4). У цьому шляху мінімальне ребро з'єднує вершини 2 і 3, його значення 5, збільшуємо пропускну спроможність на 5 (Р = 5). Віднімаємо 5 з ребер з'єднують вершини 1 і 2, 2 і 3, 3 і 4. З вихідного графа у нас випало ребро з'єднує вершини 2 і 3. Вийшов граф зображений на мал.2.
У цьому графі знову шукаємо довільний шлях з 1 в 4. Знайшли (1-2-5-4), де мінімальне ребро з'єднує 2 і 5, його значення 6. Збільшуємо пропускну здатність на 6 (P = 5 +6 = 11). Віднімаємо 6 з усіх ребер шляху, випадає ребро 2-5 (мал.3).
На наступному кроці знаходимо шлях (1-6-5-4), мінімальне ребро 1-6 дорівнює 7, тоді P = 11 +7 = 18. Віднімаємо з ребер шляху 6, при цьому випадає ребро 1-6 і граф розпадається на дві компоненти мал.4.Ми не знаходимо шляху з витоку в стіл і алгоритм завершено. Отримуємо максимальну пропуснну здатність 18 .
Повний потік . Застосовуючи правила 4, 5 алгоритму Форда-Фалкерсона, отримаємо .
Варіант 21
11 18 4 10 7 9 18 19 7 6 5 11 7 9 15 17 19
Код програми:
unit Unit8;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Grids,Math;
type
TForm8 = class(TForm)
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
Edit2: TEdit;
Button1: TButton;
StringGrid1: TStringGrid;
Label3: TLabel;
Edit3: TEdit;
Label4: TLabel;
Edit4: TEdit;
Label5: TLabel;
Memo1: TMemo;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Edit2Exit(Sender: TObject);
procedure DrawGraph;
procedure DrawLine(a1,a2,c: integer);
procedure FormPaint(Sender: TObject);
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
private
{ Private declarations }
public
{ Public declarations }
end;
TMyPoint=record
x:integer;
y:integer;
name:string
end;
const
MaxV=1000;
MaxE=30000;
free_ = 0;
bisy_ = 1;
Great=MaxLongint;
var
Form8: TForm8;
MyPoint:array[1..10] of TMyPoint;
koef:integer;
implementation
{$R *.dfm}
procedure DrawArrowHead(Canvas: TCanvas; X,Y: Integer; Angle,LW: Extended);
var
A1,A2: Extended;
Arrow: array[0..3] of TPoint;
OldWidth: Integer;
const
Beta=0.322;
LineLen=4.74;
CentLen=3;
begin
Angle:=Pi+Angle;
Arrow[0]:=Point(X,Y);
A1:=Angle-Beta;
A2:=Angle+Beta;
Arrow[1]:=Point(X+Round(LineLen*LW*Cos(A1)),Y-Round(LineLen*LW*Sin(A1)));
Arrow[2]:=Point(X+Round(CentLen*LW*Cos(Angle)),Y-Round(CentLen*LW*Sin(Angle)));
Arrow[3]:=Point(X+Round(LineLen*LW*Cos(A2)),Y-Round(LineLen*LW*Sin(A2)));
OldWidth:=Canvas.Pen.Width;
Canvas.Pen.Width:=1;
Canvas.Polygon(Arrow);
Canvas.Pen.Width:=OldWidth
end;
procedure DrawArrow(Canvas: TCanvas; X1,Y1,X2,Y2: Integer; LW: Extended);
var
Angle: Extended;
begin
Angle:=ArcTan2(Y1-Y2,X2-X1);
Canvas.MoveTo(X1,Y1);
Canvas.LineTo(X2-Round(2*LW*Cos(Angle)),Y2+Round(2*LW*Sin(Angle)));
DrawArrowHead(Canvas,X2,Y2,Angle,LW);
end;
procedure TForm8.DrawGraph;
var
x,kx,ky,a,b:integer;
begin
Form8.Refresh;
for x:=1 to 10 do
begin
kx:=3*MyPoint[x].x+koef;
ky:=3*MyPoint[x].y+koef-90;
Form8.Canvas.Ellipse(kx,ky,kx+10,ky+10);
Form8.Canvas.TextOut(kx,ky-15,MyPoint[x].name);
end;
for x := 1 to Pred(StringGrid1.RowCount) do
begin
if (StringGrid1.Cells[1,x]='') or
(StringGrid1.Cells[2,x]='') or
(StringGrid1.Cells[3,x]='') then continue;
a:= StrToInt(StringGrid1.Cells[1,x]);
b:= StrToInt(StringGrid1.Cells[2,x]);
if (a=b) then continue;
DrawLine (a,b,1);
end;
end;
procedure TForm8.DrawLine(a1,a2,c: integer);
var
x1,y1,x2,y2:integer;
begin
if c=1 then Form8.Canvas.Pen.Color:=clBlack;
if c=2 then Form8.Canvas.Pen.Color:=clRed;
x1:=3*MyPoint[a1].x+koef+5;
y1:=3*MyPoint[a1].y+koef+5-90;
//Form8.Canvas.MoveTo(x1,y1);
x2:=3*MyPoint[a2].x+koef+5;
y2:=3*MyPoint[a2].y+koef+5-90;
//Form8.Canvas.LineTo(x2,y2);
DrawArrow(Form8.Canvas,x1,y1,x2,y2,2);
Form8.Canvas.Pen.Color:=clBlack;
end;
procedure TForm8.FormCreate(Sender: TObject);
var i: integer;
begin
Randomize;
StringGrid1.Cells[0, 0] := 'Ðåáðî';
StringGrid1.Cells[1, 0] := 'Âèò³ê';
StringGrid1.Cells[2, 0] := 'Ñò³ê';
StringGrid1.Cells[3, 0] := 'Âàãà';
for i := 1 to Pred(StringGrid1.RowCount) do
begin
StringGrid1.Cells[0, i] := IntToStr(i);
//StringGrid1.Cells[1, i] := IntToStr(Random(10)+1);
// StringGrid1.Cells[2, i] := IntToStr(Random(10)+1);
// StringGrid1.Cells[3, i] := IntToStr(Random(30)+1);
end;
StringGrid1.Cells[1, 1] := IntToStr(1);
StringGrid1.Cells[2, 1] := IntToStr(2);
StringGrid1.Cells[3, 1] := IntToStr(11);
StringGrid1.Cells[1, 2] := IntToStr(2);
StringGrid1.Cells[2, 2] := IntToStr(3);
StringGrid1.Cells[3, 2] := IntToStr(17);
StringGrid1.Cells[1, 3] := IntToStr(3);
StringGrid1.Cells[2, 3] := IntToStr(4);
StringGrid1.Cells[3, 3] := IntToStr(18);
StringGrid1.Cells[1, 4] := IntToStr(2);
StringGrid1.Cells[2, 4] := IntToStr(6);
StringGrid1.Cells[3, 4] := IntToStr(4);
StringGrid1.Cells[1, 5] := IntToStr(1);
StringGrid1.Cells[2, 5] := IntToStr(6);
StringGrid1.Cells[3, 5] := IntToStr(10);
StringGrid1.Cells[1, 6] := IntToStr(1);
StringGrid1.Cells[2, 6] := IntToStr(7);
StringGrid1.Cells[3, 6] := IntToStr(7);
StringGrid1.Cells[1, 7] := IntToStr(2);
StringGrid1.Cells[2, 7] := IntToStr(7);
StringGrid1.Cells[3, 7] := IntToStr(9);
StringGrid1.Cells[1, 8] := IntToStr(6);
StringGrid1.Cells[2, 8] := IntToStr(8);
StringGrid1.Cells[3, 8] := IntToStr(8);
StringGrid1.Cells[1, 9] := IntToStr(7);
StringGrid1.Cells[2, 9] := IntToStr(6);
StringGrid1.Cells[3, 9] := IntToStr(19);
StringGrid1.Cells[1, 10] := IntToStr(8);
StringGrid1.Cells[2, 10] := IntToStr(2);
StringGrid1.Cells[3, 10] := IntToStr(7);
StringGrid1.Cells[1, 11] := IntToStr(4);
StringGrid1.Cells[2, 11] := IntToStr(8);
StringGrid1.Cells[3, 11] := IntToStr(6);
StringGrid1.Cells[1, 12] := IntToStr(4);
StringGrid1.Cells[2, 12] := IntToStr(6);
StringGrid1.Cells[3, 12] := IntToStr(5);
StringGrid1.Cells[1, 13] := IntToStr(8);
StringGrid1.Cells[2, 13] := IntToStr(5);
StringGrid1.Cells[3, 13] := IntToStr(11);
StringGrid1.Cells[1, 14] := IntToStr(5);
StringGrid1.Cells[2, 14] := IntToStr(9);
StringGrid1.Cells[3, 14] := IntToStr(7);
StringGrid1.Cells[1, 15] := IntToStr(5);
StringGrid1.Cells[2, 15] := IntToStr(10);
StringGrid1.Cells[3, 15] := IntToStr(9);
StringGrid1.Cells[1, 16] := IntToStr(9);
StringGrid1.Cells[2, 16] := IntToStr(10);
StringGrid1.Cells[3, 16] := IntToStr(16);
StringGrid1.Cells[1, 17] := IntToStr(5);
StringGrid1.Cells[2, 17] := IntToStr(8);
StringGrid1.Cells[3, 17] := IntToStr(17);
StringGrid1.Cells[1, 18] := IntToStr(10);
StringGrid1.Cells[2, 18] := IntToStr(3);
StringGrid1.Cells[3, 18] := IntToStr(19);
MyPoint[1].x:=10;
MyPoint[1].y:=70;
MyPoint[1].name:='1';
MyPoint[2].x:=30;
MyPoint[2].y:=100;
MyPoint[2].name:='2';
MyPoint[3].x:=50;
MyPoint[3].y:=50;
MyPoint[3].name:='3';
MyPoint[4].x:=70;
MyPoint[4].y:=120;
MyPoint[4].name:='4';
MyPoint[5].x:=90;
MyPoint[5].y:=30;
MyPoint[5].name:='5';
MyPoint[6].x:=110;
MyPoint[6].y:=90;
MyPoint[6].name:='6';
MyPoint[7].x:=130;
MyPoint[7].y:=60;
MyPoint[7].name:='7';
MyPoint[8].x:=150;
MyPoint[8].y:=110;
MyPoint[8].name:='8';
MyPoint[9].x:=170;
MyPoint[9].y:=40;
MyPoint[9].name:='9';
//MyPoint[10].x:=190;
//MyPoint[10].y:=100;
//MyPoint[10].name:='10';
MyPoint[10].x:=210;
MyPoint[10].y:=70;
MyPoint[10].name:='10';
DrawGraph;
koef:=260;
end;
procedure TForm8.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]]{!};
Memo1.Lines.Add(InttoStr(cf) + ' - '+ inttostr(x));//+' - '+ inttostr(f[poz[x]])) ;
if cf<Min Then Min:=cf;
x:=prev[x];
//Memo1.Lines.Add('--'+InttoStr(poz[x]));
end;
Memo1.Lines.Add(' -> '+inttostr(x));
Memo1.Lines.Add(' ');
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];
//Memo1.Lines.Add(InttoStr(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;
Label5.Caption:='Ðåçóëüòàò: '+ IntToStr(MaxPotok);
end;
procedure TForm8.Edit2Exit(Sender: TObject);
var i: integer;
m: longint;
begin
m := StrToIntDef(Edit2.Text, 0);
if m = 0 then
begin
ShowMessage('Íåâ³ðí³ ââåäåí³ âõ³äí³ äàí³!');
exit
end;
StringGrid1.RowCount := m + 1;
for I := 1 to Pred(StringGrid1.RowCount) do
StringGrid1.Cells[0, i] := IntToStr(i);
end;
procedure TForm8.FormPaint(Sender: TObject);
var
x,kx,ky:integer;
begin
for x:=1 to 10 do
begin
kx:=3*MyPoint[x].x+koef;
ky:=3*MyPoint[x].y+koef-90;
Form8.Canvas.Ellipse(kx,ky,kx+10,ky+10);
Form8.Canvas.TextOut(kx,ky-15,MyPoint[x].name);
end;
end;
procedure TForm8.StringGrid1SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
DrawGraph;
end;
end.
Результат:
Висновок: на даній лабораторній роботі я ознайомився з алгоритмом Форда-Фалкерсона, та навчися розв*язувати задачі на знаходження пропускної спроможності графа.
15.10.2013 11:10-
Ділись своїми роботами та отримуй миттєві бонуси!
0%
Оголошення від адміністратора