PHÂN TÍCH VÀ CÀI ĐẶT

PHÂN TÍCH VÀ CÀI ĐẶT
I. PHÂN TÍCH BÀI TOÁN
1. Mô hình bài toán
Giả xử trong đồ thị G, ngoài khả năng thông qua của các cung c(u,v), ở mỗi
đỉnh v
∈
V còn có khả năng thông qua của đỉnh là d(v), và đòi hỏi tổng luồng đi vào
đỉnh v không còn vượt quá d(v), tức là
∑
∈
≤
Vw
vdvwf )(),(
Cần phải tìm luồng cực đại giữa s và t trong mạng như vậy.
Xây dựng một mạng G’ sao cho: mỗi đỉnh v của G tương ứng với hai đỉnh v
+
, v
-
trong G’, mỗi cung (u,v) trong G ứng với cung (u,v
+
) trong G’, mỗi cung (v,w) trong G
ứng với cung (v
-
,w
+
) trong G’. Ngoài ra, mỗi cung (v
+
,v
-
) trong G’ có khả năng thông
qua là d(v), tức là bằng khả năng thông qua của đỉnh v trong G.

2. Phương pháp giải quyết
Từ mạng G = (V,E) với khả năng thông qua các cung các đỉnh. Ta tìm luồng
cực đại của mạng qua hai bước sau:
Bước 1: Xác định mạng G’.
Bước 2: Tìm luồng cực đại trong mạng G’. Bắt đầu từ luồng zero với khả năng
thông qua cung.
Hai bước trên ta có thể biểu diễn dưới dạng sơ đồ thuật toán sau:
1 1
Begin
Mạng G
Mạng G’
Luồng cực đại trên G’
End
di nếu i = jc[i,j] nếu [i,j] E0 nếu [i,j] E
A = ( aij ) =
A’ = ( a’ij ) =
nếu i = jc[i,j] nếu [i,j] E’
3. Biểu diễn đồ thị
3.1 Biểu diễn mạng G với khả năng thông qua các cung - đỉnh
Giả sử mạng G = (V,E), |V| = n. Ta có thể biểu diễn bởi ma trận trọng số A cấp
n x n như sau:

Trong đó: d
i
là khả năng thông qua đỉnh i; C[i,j] khả năng thông qua cung [i,j].
3.2 Biểu diễn mạng G’ tương ứng với mạng G
Mạng tương ứng với G = (V,E), |V | = n là mạng G’ = (V’,E’), |V’| = 2 |V |, |E’|
= 2 |E | - 1. Được biểu diễn thông qua ma trận A’ cấp (2n x 2n) như sau:
2 2
s[7]

1
32
45
t[6]
v[8]
u[6]
A =
s u v t7 5 2 0 s0 6 1 4 u0 0 8 3 v0 0 0 6 t
t-
6
t+
4
3
1
v-
8v+
u-
6
u-
5
s-
7
2
s+
s+ s- u+ u- v+ v- t+ t-0 7 0 0 0 0 0 0 s+0 0 5 0 2 0 0 0 s-0 0 0 6 0 0 0 0 u+0 0 0 0 1 0 4 0 u-0 0 0 0 0 8 0 0 v+0 0 0 0 0 0 3 0 v-0 0 0 0 0 0 0 6 t+0 0 0 0 0 0 0 0 t-
Thí dụ 3. Như thí dụ trên có mạng G như sau:
Ta có ma trận biểu diễn mạng G :
Tương tự từ mạng G’:
Ta có ma trận biểu diễn mạng G’ như sau:
3 3

s+ s- u+ u- v+ v- t+ t-0 6 0 0 0 0 0 0 s+0 0 4 0 2 0 0 0 s-0 0 0 4 0 0 0 0 u+0 0 0 0 0 0 4 0 u-0 0 0 0 0 2 0 0 v+0 0 0 0 0 0 2 0 v-0 0 0 0 0 0 0 6 t+0 0 0 0 0 0 0 0 t-
Áp dụng T.T Ford-Fulkerson tìm luồng cực đại cho mạng G’ ta được mạng cực
đại và ma trận biểu diễn nó như sau:
Với Val(f
*
) = 6
III. MỘT SỐ HÀM VÀ THỦ TỤC CỦA CHƯƠNG TRÌNH NGUỒN
procedure Initgr;
var
Gd, Gm: Integer;
Radius: Integer;
begin
Gd := Detect;
InitGraph(Gd, Gm, 'D:\bp\bgi ');
if GraphResult <> grOk then
Halt(1);
end;
(*==================================================*)
procedure readfile;
var
i,j:word;
kt:array[1..max] of integer;
begin
readln(ff,Ssv,Sn);
for i:=1 to Ssv do
begin
for j:=1 to Sn do read(ff,C^[i,j]);
readln(ff,e[i]);
end;
end;

(*==============================================*)
{procedure sum_ei;
var kt:array[1..max] of integer;
4 4
snc,i,j:word;
begin
snc:=snc+1;
for i:=1 to Ssv do
kt[i]:=kt[i]+C^[i,j];
end;
function Ok:boolean;
var ktra:boolean;
kt:array[1..max] of integer;
r,i,j:word;
begin
readfile;
sum_ei;
ktra:=false;
for i:=1 to ssv do
begin
r:=0;
for j:=1 to sn do
r:= r+C^[i,j];
if r < kt[i] then begin
ktra:=false;
exit;
end
else ktra:=true;
end;
Ok:=ktra;

end;}
(*==============================================*)
function min(a,b:integer):integer;
begin
if a>b then min:=b else min:=a;
end;
(*==========================================*)
function EmptyVt:word;
var
i:word;
begin
EmptyVt:=0;
for i:=1 to N do
if Vt[i]=1 then
begin
EmptyVt:=i;
5 5
exit;
end;
end;
(*================================================*)
{Tìm đường đi để tăng luồng}
procedure find_path;
begin
fillchar(Vt,sizeof(vt),0);
ee[sw]:=INF;
p[sw]:=sw;
Vt[sw]:=1;
pathfound:=true;
while EmptyVt<>0 do

begin
u:=EmptyVt;
Vt[u]:=2;
for v:=1 to n do
if (Vt[v]=0) and(u<>v) then
begin
if (C^[u,v]>0) and (f^[u,v]<C^[u,v]) then
begin
p[v]:=u;
ee[v]:=min(ee[u],C^[u,v]-f^[u,v]);
Vt[v]:=1;
if v=t then exit;
end;
if (C^[v,u]>0) and (f^[v,u]>0) then
begin
p[v]:=-u;
ee[v]:=min(ee[u],f^[v,u]);
Vt[v]:=1;
if v=t then exit;
end;
end;
end;
pathfound:=false;
end;
(*=========================================*)
{tìm được đường đi rồi đến thủ tục tăng luồng}
procedure inc_flow;
begin
v:=p[t];u:=t;
while u<>sw do

begin
6 6
if v>0 then begin f^[v,u]:=f^[v,u]+ee[t];end
else
begin
v:=-v;
f^[u,v]:=f^[u,v]-ee[t];
end;
u:=v;v:=p[u];
end;
end;
(*==========================================*)
{thuật toán tăng luồng toàn bộ để tìm luồng cực đại}
procedure Max_flow;
var
stop:boolean;
begin
for u:=1 to N do
for v:=1 to N do f^[u,v]:=0;
stop:=false;
while not stop do
begin
Find_path;
if pathfound then inc_flow
else stop:=true;
end;
end;
(*======================================================*)
{Chuyển Ma trận cho dưới dạng quan hệ thành ma trận để thực hiện luồng cực đại
input : C[i,j] là quan hệ hàng i và cột j c[i,j]=1 else c[i,j]:=0;

Sn:so cột
Ssv:so hàng
e[i]:so bat buoc cua hàng i
}
procedure TransMatrixFlow;
var
i,j:word;
begin
N:=Sn+Ssv+2;
sw:=1;
t:=N;
for i:=1 to Ssv do
for j:=1 to Sn do F^[i,j]:=c^[i,j];
fillchar(c^,sizeof(c^),0);
{gan them diem cuoi den tat ca cac nhom co luong vo cung}
for j:=1 to Ssv do C^[1,j+1]:=e[j];
7 7
for j:=1 to Sn do
for i:=1 to Ssv do
C^[i+1,Ssv+j+1]:=F^[i,j];
{gan them diem dau den tat ca cac SV co luong vo cung}
for i:=1 to Sn do
begin
C^[Ssv+i+1,N]:=INF;
end;
end;
(*===================================================*)
{đổi 2 nhóm sao cho chênh lệch là bé nhất}
procedure changegroup(n1,n2:word);
var

c1,i,j,k1,k2:word;
begin
if F^[Ssv+1,n1]=F^[Ssv+1,n2] then exit;
if F^[Ssv+1,n1]>F^[Ssv+1,n2] then begin k1:=n1;k2:=n2;end
else
begin
k1:=n2;
k2:=n1;
end;
for c1:=1 to Ssv do
if (F^[Ssv+1,k1]>F^[Ssv+1,k2]) and (c1<=Ssv)
and (F^[c1,k1]=1)and (C^[c1,k2]=1) and (F^[c1,k2]=0) then
begin
F^[c1,k1]:=0;F^[c1,k2]:=1;
dec(F^[Ssv+1,k1]);
inc(F^[Ssv+1,k2]);
inc(c1);
end;
end;
(*==============================================*)
procedure TransresultM;
var
t,i,j:word;
begin
for i:=1 to Ssv do
begin
for j:=1 to Sn do
begin
F^[i,j]:=F^[i+1,Ssv+j+1];
C^[i,j]:=C^[i+1,Ssv+j+1];

end;
8 8
F^[i,Sn+1]:=e[i];
end;
{tinh so SV trong nhom}
for j:=1 to Sn do
begin
t:=0;
for i:=1 to Ssv do t:=t+F^[i,j];
F^[Ssv+1,j]:=t;
end;
for i:=1 to Sn do
for j:=1 to Sn do
if i<>j then changeGroup(i,j);
end;
(*================================================*)
procedure init;
begin
clrscr;
new(C);
if c=nil then writeln('Khong du bo nho');
new(F);
if F=nil then writeln('Khong du bo nho');
end;
(*===============================================*)
procedure finish;
begin
if c<>nil then dispose(C);
if F<>nil then dispose(F);
end;

procedure writexy(x,y:integer;clr:byte;s:string);
begin
gotoxy(x,y);
textattr:=clr;
write(s);
end;
(*===================================================*)
(* copy ký tự ch, tại vị trí thứ j ,trong chuỗi s*)
function cpystr(s:string;ch:char;j:byte):string;
var
ie,i,is:byte;
nn,nl:byte;
begin
nn:=0;
cpystr:='';
9 9
nl:=length(s);
i:=1;
while (i<=nl) and (nn<>j) do
begin
if s[i]=ch then nn:=nn+1;
inc(i);
end;
if i<nl then
begin
is:=i;
while (i<=nl) and (s[i]<>ch) do inc(i);
if i<=nl then
begin
ie:=i;

cpystr:=copy(s,is,ie-is);
exit;
end;
end;
end;
(*========================================================*)
function popupmenu(x,y,w,nitem:integer;pmenu:string;clrsel,clback:byte):byte;
var
cmd,index,i:byte;
ssel:string;
c:char;
begin
ssel:='';
index:=1;
for i:=1 to w do ssel:=ssel+' ';
drawwindow(x,y,x+w+2,y+nitem+1,$70,$70,1); {dat mau cho khung hoi thoai}
for i:=1 to nitem do writexy(1,i,clback,cpystr(pmenu,'/',i));
repeat
writexy(1,index,clrsel,ssel);
writexy(1,index,clrsel,cpystr(pmenu,'/',index));
c:=readkey;
writexy(1,index,clback,ssel);
writexy(1,index,clback,cpystr(pmenu,'/',index));
case c of
#72:if index>1 then dec(index) else index:=nitem;
#80:if index<nitem then inc(index) else index:=1;
#75:cmd:=$80;
#77:cmd:=$81;
#13:cmd:=index;
#27:cmd:=0;

10 10