PHÂN TÍCH VÀ CÀI ĐẶT
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 đó: di 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:
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 :
47 di nếu i = j c[i,j] nếu [i,j] ∈ E 0 nếu [i,j] ∉ E A = ( aij ) =
A’ = ( a’ij) = nếu i = j
c[i,j] nếu [i,j] ∈ E’
s[7] 1
3 2
4 5
t[6]
v[8]
u[6]
A =
s u v t 7 5 2 0 s 0 6 1 4 u 0 0 8 3 v 0 0 0 6 t
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-
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-
Tương tự từ mạng G’:
Ta có ma trận biểu diễn mạng G’ như sau:
Á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
t- 6
t+ 4
3 1
v- v+ 8
u- u- 6
5 s-
7 2
s+
A’ =
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-
C =
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-
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;
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
49
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;
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
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;
51
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];
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;
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
53
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:='';
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;
end;
until (c=#13)or (c=#27) or (cmd>=$80);
popupmenu:=cmd;
end;
(*=============================================*) function menubar(clr,clrsel,opt:byte):word;
var
index,i :byte;
cmd :word;
xs :array[1..NUMPOPUP] of byte;
luuscreen:^byte;
begin
xs[1]:=2;
index:=1;
getmem(luuscreen,80*25*2);
if luuscreen=nil then exit;
for i:=2 to NUMPOPUP do
xs[i]:=xs[i-1]+length(cpystr(MenuBarStr,'/',i))+2;
window(1,1,80,1);
textattr:=clr; {const MenuBarStr:string='/File / Exe / Help /';}
clrscr;
for i:=1 to NUMPOPUP do
writexy(xs[i],1,clr,cpystr(MenuBarStr,'/',i));
if opt=0 then exit;
move(ptr($B800,0)^,luuscreen^,80*25*2);
repeat
window(1,1,80,1);
55
textattr:=clr;
writexy(xs[index],1,clrsel,cpystr(MenuBarStr,'/',index));
cmd:=popupmenu(xs[index],2,20,popupnum[index],mnupopup[index],clrsel,clr);
if (cmd=$80) or (cmd=$81) then Move(luuscreen^,ptr($B800,0)^,80*25*2);
{ function Ptr(Seg, Ofs: Word): Pointer;
Converts a segment base and an offset address to a pointer-type value.}
{procedure Move(var Source, Dest; Count: Word);Copies bytes from source to dest.}
if (cmd=$80) then
if (index>1) then dec(index) else index:=NUMPOPUP;
if (cmd=$81) then
if (index<NUMPOPUP) then inc(index) else index:=1;
until (cmd=0) or (cmd<$80);
(*cau lenh thay doi gia tri cua cac tuy chon kkkkkkkkkkkkkkkkkk*) if (cmd<>0) then cmd:=(index shl 8) or cmd;
move(ptr($B800,0)^,luuscreen^,80*25*2);
freemem(luuscreen,80*25*2);
menubar:=cmd;
end;
(*=================================================*) procedure writestatus(s:string);
begin
textattr:=$74;
clrscr;
write(s);
end;
(*=================================================*) procedure message(s:string);
begin
drawwindow(20,5,60,7,$21,$21,2);
write(s);
readln;
end;
(*==================================================*) function inputbox(tilte:string):string;
var s:string;
begin
drawwindow(20,10,60,13,$21,$21,2);
write(tilte);
drawwindow(25,12,55,12,$7F,$1F,0);
readln(s);
inputbox:=s;
end;
(*=============================================*) procedure repaint;
begin
{ window(1,1,80,25);}
clrscr;
textattr:=$00;
window(1,25,80,25);
writestatus(' F10');
writexy( 3,23,$70,' Show Menu'); {(*$70:dat mau cho statusbar*)}
menubar($70,$70,0); {dat mau cho toolbar}
drawwindow(1,2,80,24,$1f,$1F,0);
{(*$1f,$1f mau nen:3bit cao, mau chu :4 bit thap*)}
end;
(*=========================================================*) (* CAC THU TUC TUONG UNG VOI CAC MENU *)
(*=========================================================*) function FileExit(filename:ss):boolean;
var f:text;
begin {$I-}
assign(f,filename);
reset(f);
close(f);
{$I+}
FileExit:=(Ioresult=0)and(filename<>'');
end;
{---}
procedure savefile;
var i,j:word;
begin repaint;
fileinput:=inputbox('Nhap Duong dan va ten File:');
assign(ff,fileinput);
{$I-}
rewrite(ff);
{$I+}
if IOresult<>0 then message('File khong hop le hoac sai duong dan') else
begin
for i:=1 to ssv+1 do begin
for j:=1 to sn do write(ff,F^[i,j]:5);
writeln(ff,e[i]:5);
57
end;
close(ff);
end;
end;
(* ============================================= *) procedure openfile;
var i,j:byte;
begin repaint;
fileinput:=inputbox('Nhap Duong dan va ten File :');
assign(ff,fileinput);
{$I-}
reset(ff);
{$I+}
if IOresult<>0 then message('File khong ton tai hoac sai duong dan') else
begin readfile;
close(ff);
end;
repaint;
drawwindow(1,2,79,24,$1F,$1F,2);
writeln('Ma tran dang ky :');
writeln;
for i:=1 to Ssv do begin
for j:=1 to Sn do write(C^[i,j]:3);writeln;
end;
writeln;
for i:=1 to Ssv do begin
gotoxy(25,i+2);
writeln(e[i]);
end;
gotoxy(22,1);write('Chi tieu :');
readln;
end;
(*---*) procedure newfile;
var f:string;
j,i,cn,m:word;
key:char;
begin REPAINT;
drawwindow(1,2,79,24,$1F,$1F,2);
write('Nhap So hang <= 200 : ');readln(ssv);
write('Nhap So cot <= 100 : ');readln(sn);
writeln('CHU Y !');
writeln('1. Hang i quan he cot j thi C[i,j] = 1, nguoc lai C[i,j]= 0.');
writeln('2. Nhap Du Lieu chi gom cac so 0 hoac 1.');
writeln('3. Neu ban nhap sai ban phai nhap lai .');
writeln('4. Cho den khi thoa man dieu kien de bai.');
for i:=1 to ssv do begin
for j:=1 to sn do begin
repeat
write('C[',i,',',j,']:=');
readln(C^[i,j]);
until C^[i,j] in [0,1];
end;
repeat
write('Nhap so nhom ma hang ',i,' Phai tham gia: P',i,' = ');
readln(e[i]);
if e[i] > sn then begin
writeln('Nhap sai !, Nhap lai .');
writeln('So nhom phai tham gia P',i,' <= ',sn,' (So ban vua nhap)');
end;
until e[i] <= sn;
end;
repaint;
f:=inputbox('Nhap Duong dan va ten File:');
assign(ff,f);
{$I-}
rewrite(ff);
{$I+}
if IOresult<>0 then message('File khong hop le hoac sai duong dan') else
begin
writeln(ff,ssv,' ',sn);
for i:=1 to ssv do begin
for j:=1 to sn do write(ff,C^[i,j],' ');
writeln(ff,e[i]);
end;
close(ff);
59
end;
end;
(******************************************************************) (* CHUAN BI MO PHONG *)
(******************************************************************) procedure xuat;
begin
setcolor(9);
settextstyle(1,0,1);
settextjustify(2,8);
outtextxy(460,405,' GVHD : DO NHU AN ');
outtextxy(438,428,' SVTH : Ngo Tao Vinh ' );
outtextxy(438,446,' LOP : Tin 40 DHTS ');
end;
(*---*) procedure display;
begin
setfillstyle(1,7);
bar(1,0,getmaxx,24);
setfillstyle(1,8);(* mau nen*) bar(1,25,getmaxx,getmaxy-100);
setcolor(9);
Bar(1,25,getmaxx,getmaxy);
setcolor(2); (*set color chu *)
bar(1,getmaxy-90,getmaxx,getmaxy);
setcolor(2);
settextstyle(1,0,2);
settextjustify(1,1);
outtextxy(160,450,'Phan Nhom Sinh hoat ');
outtextxy(170,420,'Ford - Fulkerson Algorithms');
xuat;
setcolor(15);
line(1,getmaxy-92,getmaxx,getmaxy-92);
line(1,getmaxy-91,getmaxx,getmaxy-91);
line(321,25,321,getmaxy-92);
line(321,26,321,getmaxy-93);
line(1,22,getmaxx,22);
line(1,23,getmaxx,23);
end;
(*---*)
procedure vechu(x,y:integer;st:string;mau,co,cl,jus:word);
begin
setcolor(cl);
settextjustify(jus,1);
settextstyle(mau,0,co);
outtextxy(x,y,st);
end;
{---}
{thu tuc ve khung voi ca c toa do (x1,y1) x2,y2 voi mau cl}
procedure khung(x1,y1,x2,y2,cl:integer);
begin
setcolor(cl);
line(x1,y1,x2,y1);
line(x1,y1,x1,y2);
line(x1,y2,x2,y2);
line(x2,y1,x2,y2);
end;
(*=====================================================*) procedure vechu1;
var i,j:byte;
begin
settextstyle(0,1,0);
setcolor(15);
outtextxy(15,140,'Sinh Vien Dang Ky');
setcolor(14);
line(21,80,21,215);
line(16,210,21,215);
line(26,210,21,215);
setcolor(15);
settextstyle(0,0,0);
outtextxy(80,80,'Nhom Dang Ky');
setcolor(14);
line(40,90,190,90);
line(185,85,190,90);
line(185,95,190,90);
for j:=1 to sn do begin
for i:=1 to ssv do begin
str(C^[i,j],s);
setcolor(15);
settextstyle(0,0,1);
outtextxy(21*j+7,14*i+85,s);
61
end;
end;
{j:=sn+1;}
for i:=1 to ssv do begin
str(e[i],s);
setcolor(15);
settextstyle(0,0,1);
outtextxy(210,14*i+85,s);
setcolor(15);
settextstyle(0,0,0);
outtextxy(190,80,'Chi Tieu');
end;
(* Viet ma tran ket qua *) { setcolor(15);
settextstyle(0,1,0);
outtextxy(getmaxx div 2+15,80,'Sinh Vien Duoc PN');
setcolor(14);
line(getmaxx div 2+25,90,30,21,((getmaxY-44) div 2)+165);}
{ line(getmaxx div 2+21,((getmaxY-44) div 2)+30,21,((getmaxY-44) div 2)+165);
line(getmaxx div 2+16,((getmaxY-44) div 2)+160,21,((getmaxY-44) div 2)+165);
line(getmaxx div 2+26,((getmaxY-44) div 2)+160,21,((getmaxY-44) div 2)+165);
setcolor(15);
settextstyle(0,0,0);
outtextxy(40,((getmaxY-44) div 2)+30,'Nhom Dang Ky');
setcolor(14);
line(40,((getmaxY-44) div 2)+40,190,((getmaxY-44) div 2)+40);
line(185,((getmaxY-44) div 2)+35,190,((getmaxY-44) div 2)+40);
line(185,((getmaxY-44) div 2)+45,190,((getmaxY-44) div 2)+40);}
for j:=1 to sn do begin
for i:=1 to ssv do begin
str(F^[i,j],s);
setcolor(15);
{outtextxy(21*j+7,14*i+(getmaxY-44) div 2+40,s);}
outtextxy(getmaxx div 2+25+21*j+7,14*i+85,s);
end;
end;
{setcolor(15);
outtextxy(100,70,'Ma Tran Dang Ky');
outtextxy(100,240,'Ma Tran Ket Qua');}
{ for i:=1 to ssv do begin
for j:=1 to sn do begin
str(C^[j,i],s);
setcolor(15);
outtextxy(20*i+ssv,20*j+(sn+1)+70,s);
end;
end;}
end;
(*---*) procedure toado1;
var i,j,k:integer;
x11,y11,x22,y22:integer;
tdotrai,tdophai,qqq,tdoy,temp,sogia:word;
begin
setcolor(15);
tdotrai:=15;tdophai:=getmaxx div 2-15;
tdoy:=getmaxy div 2;
i:=1;k:=1;qqq:=1;
while (qqq<=ssv+sn) do begin
if temp<6 then sogia:=100 else sogia:=50;
toado[i].x:=30+tdotrai+50;
toado[i].y:=sogia+50*qqq;
toadoo[k].x:=30+tdophai-100;
toadoo[k].y:=sogia+50*qqq;
i:=i+1;k:=k+1;qqq:=qqq+1;
end;
for i:=1 to ssv do begin
x11:=toado[i].x;
y11:=toado[i].y;
setcolor(4);
circle(x11,y11,7);
circle(x11,y11,6);
setfillstyle(1,15);
floodfill(x11,y11,4);
setcolor(3);
settextstyle(0,0,0);
outtextxy(x11,y11-15,chr(48+i));
setcolor(4);
line(tdotrai,tdoy,toado[i].x,toado[i].y);
63
end;
for k:=1 to sn do begin
x22:=toadoo[k].x;
y22:=toadoo[k].y;
setcolor(4);
circle(x22,y22,7);
circle(x22,y22,6);
setfillstyle(1,15);
floodfill(x22,y22,4);
setcolor(3);
settextstyle(0,0,0);
outtextxy(x22,y22-15,chr(48+k));
setcolor(4);
line(tdophai,tdoy,toadoo[k].x,toadoo[k].y);
end;
setcolor(4);
circle(tdotrai,tdoy,7);
circle(tdotrai,tdoy,6);
setfillstyle(1,15);
floodfill(tdotrai,tdoy,4);
setcolor(3);
settextstyle(0,0,0);
settextjustify(tdotrai,tdoy);
outtextxy(tdotrai,tdoy-15,'s');
setcolor(4);
circle(tdophai,tdoy,7);
circle(tdophai,tdoy,6);
setfillstyle(1,15);
floodfill(tdophai,tdoy,4);
setcolor(3);
settextstyle(0,0,0);
settextjustify(tdophai,tdoy);
outtextxy(tdophai,tdoy-15,'t');
for i:=1 to ssv do begin
for j:=1 to sn do if C^[i,j]=1 then begin
setcolor(4);
line(toado[i].x,toado[i].y,toadoo[j].x,toadoo[j].y);
end;
end;
end;
(*========================================================*) procedure toado2;
var i,j,k,m,x11,y11,x22,y22:integer;
tdotrai,tdophai,qqq,tdoy,temp,sogia:word;
begin
setcolor(15);
tdotrai:=getmaxx div 2+15;tdophai:=getmaxx -15;
tdoy:=getmaxy div 2;
i:=1;k:=1;qqq:=1;
while (qqq<=ssv+sn) do begin
if temp<6 then sogia:=100 else sogia:=50;
toado[i].x:=30+tdotrai+50;
toado[i].y:=sogia+50*qqq;
toadoo[k].x:=30+tdophai-80;;
toadoo[k].y:=sogia+50*qqq;
i:=i+1;k:=k+1;qqq:=qqq+1;
end;
for i:=1 to ssv do begin
x11:=toado[i].x;
y11:=toado[i].y;
setcolor(4);
circle(x11,y11,7);
circle(x11,y11,6);
setfillstyle(1,15);
floodfill(x11,y11,4);
setcolor(3);
settextstyle(0,0,0);
settextjustify(100,100);
outtextxy(x11,y11-15,chr(48+i));
setcolor(4);
line(tdotrai,tdoy,toado[i].x,toado[i].y);
end;
for k:=1 to sn do begin
x22:=toadoo[k].x;
y22:=toadoo[k].y;
setcolor(4);
65
circle(x22,y22,7);
circle(x22,y22,6);
setfillstyle(1,15);
floodfill(x22,y22,4);
setcolor(3);
settextstyle(0,0,0);
settextjustify(100,100);
outtextxy(x22,y22-15,chr(48+k));
setcolor(4);
line(tdophai,tdoy,toadoo[k].x,toadoo[k].y);
end;
setcolor(4);
circle(tdotrai,tdoy,7);
circle(tdotrai,tdoy,6);
setfillstyle(1,15);
floodfill(tdotrai,tdoy,4);
setcolor(3);
settextstyle(0,0,0);
settextjustify(tdotrai,tdoy);
outtextxy(tdotrai,tdoy-15,'s');
setcolor(4);
circle(tdophai,tdoy,7);
circle(tdophai,tdoy,6);
setfillstyle(1,15);
floodfill(tdophai,tdoy,4);
setcolor(3);
settextstyle(0,0,0);
settextjustify(tdophai,tdoy);
outtextxy(tdophai,tdoy-15,'t');
for i:=1 to ssv do begin
for j:=1 to sn do if F^[i,j]=1 then begin
setcolor(4);
line(toado[i].x,toado[i].y,toadoo[j].x,toadoo[j].y);
end;
end;
end;
(*======================================================*) procedure Mophong;
begin
TransMatrixFlow;
max_flow;
TransresultM;
Initgr;
display;
{ setbkcolor(8);}
Outtextxy(140,45,'GRAPH INPUT');
Outtextxy(478,45,'GRAPH OUTPUT ');
toado1;
toado2;
READLN;
closegraph;
end;
(*---*) procedure phannhom;
begin {if ok then begin}
TransMatrixFlow;
max_flow;
TransresultM;
initgr;
display;
Outtextxy(140,45,'MA TRAN A BIEU DIEN MANG G ');
Outtextxy(478,45,'LUONG CUC DAI TRONG MANG G ');
vechu1;
{ end else begin initgr;
display;
setcolor(4);
outtextxy(50,100,'Khong phan nhom duoc');
end;}
READLN;
closegraph;
end;
(*=========================================================*) (* CHON LENH LAM VIEC *)
(*=========================================================*) function menu(c:byte):word;
var
cmd:word;
begin
if c=68 then
67
begin
cmd:=menubar($70,$20,1); {(*$20,$70 mau nen:3bit cao, mau chu :4 bit thap*)}
case cmd of
IDNEW : newfile;
IDOPEN : openfile;
IDSAVE : savefile;
IDPNHOM: phannhom;
IDMOPHONG :Mophong;
IDABOUT :about;
end;
repaint;
end;
menu:=cmd;
end;
(*---*) procedure appinit;
begin init;
textmode(C80);
repaint;
end;
(*---*) var
cmd:word;
begin appinit;
repeat
cmd:=menu(port[$60]);
until (cmd=0)or(cmd=IDEXIT)OR(port[$60]=1) ; finish;
end.
II. MỘT SỐ GIAO DIỆN CHÍNH CỦA CHƯƠNG TRÌNH