Gián án DO THI

CẤU TRÚC ĐỒ THỊ
Laptrinh_Hieu
19
I. Cấu trúc lưu trữ
1. 1. Ma trận kề
1 2 j N
2

i X

N
- A[i, j] = X: Có cung (i, j)
- A[i, j] = 0: Không có cung (i, j).
Nếu đồ thị có trọng số thì X = trọng số.
Nếu đồ thị không có trọng số thì X = 1.
Nếu đồ vị vô hướng thì A[i, j] ≠ A[j, i]
1. 2. Danh sách lân cận
II. Các thuật toán cơ bản với cấu
trúc ma trận
2. 1. Khai báo
const MAX =100;
Type mang =array[1..100,1..100] of
byte;
mang1 = array[1..100] of integer;
mang2 = array[1..100] of boolean;
var G,T: mang; {Do thi}
n,top,d,c: integer;
ctham : mang2;
S,tr,kq: mang1; {Stack}
{Đọc đồ thị từ file}
procedure load_file;

var i,j: integer;
f: text;
begin
assign(f,'DOTHI.dat');
{Kiểm tra sự tồn tại của file}
{$I-}
reset(f);
close(f);
{$I+}
if IOResult <> 0 then
begin
writeln('File khong ton tai');
readln;
halt; {Thoát khỏi ứng dụng}
end;
reset(f);
readln(f,n);
for i:=1 to n do
begin
for j:=1 to n do
read(f,g[i,j]);
readln(f);
end;
end;
2. 2. Duyệt sâu giải thuật đệ quy
procedure sau(u: integer);
{Thủ tục con lồng nhau}
procedure try(i: integer);
var j: integer;
begin

write(i,' ');
ctham[i] := false;
for j:=1 to n do
if ctham[j]and (g[i,j]<>0) then
begin
try(j);
end;
end;
begin
fillchar(ctham,n,true);
try(u);
end;
2. 3. Duyệt rộng
procedure rong(u:integer);
var i,j: integer;
begin
fillchar(ctham,MAX, true);
d := 1;
c := 0; {Khởi tạo Queue rỗng}
write(u,' ');
ctham[u]:= false; {thăm nút đầu tiền}
c := c+1;
s[c] := u; {Nạp U vào Queue}
while d<=c do
begin
i := s[d];
inc(d); {Lấy ra khỏi Queue}
for j:=1 to n do
if (g[i,j]<>0)and ctham[j] then
begin

ctham[j] := false;
write(j,' ');
inc(c);
s[c] := j; {Nạp J vào Queue}
end;
end;
end;
2
2
1
3
3
3
2
5
4
3
4
5
V[1]
V[2]
V[3]
V[4]
V[5]
CẤU TRÚC ĐỒ THỊ
Laptrinh_Hieu
20
2. 4. Tìm đường đi ngắn nhất với đồ
thị không có trọng số
{ Vận dụng duyệt rộng để giải}

procedure ngannhat(u,v: integer);
var i,j: integer;
begin
fillchar(ctham,MAX, true);
d := 1;
c := 0;
tr[u] := u;
ctham[u]:= false;
c := c+1;
s[c] := u;
while d<=c do
begin
i := s[d];
inc(d);
for j:=1 to n do
if (g[i,j]<>0)and ctham[j] then
begin
tr[j] := i; {luu vet}
ctham[j] := false;
inc(c);
s[c] := j;
end;
end;
{ Tìm đường theo vết}
i := v;
d := 1;
kq[d] := v;
while i <> u do
begin
d := d+1;

kq[d] := tr[i];
i := tr[i];
end;
write('duong di: ');
for i:= d downto 1 do
write(kq[i],' ');
end;
2. 5. Kiểm tra liên thông
procedure try1(i: integer);
var j: integer;
begin
ctham[i] := false;
for j:=1 to n do
if ctham[j]and (g[i,j]<>0) then
begin
try1(j);
end;
end;
function lienthong : boolean;
var i:integer;
begin
fillchar(ctham, MAX, true);
try1(1);
for i:=1 to n do
if ctham[i] = true then
begin
lienthong := false;
exit;
end;
lienthong := true;

end;
2. 6. Đếm số miền liên thông
function somien: integer;
var i, dem : integer;
begin
fillchar(ctham, MAX, true);
dem := 0;
for i:=1 to n do
if ctham[i] = true then
begin
try1(i); dem := dem+1;
end;
somien := dem;
end;
2. 7. Kiểm tra tồn tại chu trình
function chutrinh : boolean;
var a: mang; i: integer;
procedure try(i: integer);
var j: integer;
begin
tr[i] := tr[i] + 1;
for j:=1 to n do
if a[i,j] <> 0 then
begin
a[i,j] := 0;
a[j,i] := 0;
try(j);
end;
end;
begin

a := g;
for i:=1 to n do
tr[i] := 0;
for i:=1 to n do
if tr[i] = 0 then try(i);
for i:=1 to n do
if tr[i] > 1 then
begin
chutrinh := true; exit;
end;
chutrinh := false;
end;
CẤU TRÚC ĐỒ THỊ
Laptrinh_Hieu
21
III. Cây khung và cây khung cực
tiểu
3. 1. Dựng cây khung theo chiều sâu
procedure try(i: integer);
var j: integer;
begin
ctham[i] := false;
for j:=1 to n do
if ctham[j]and (g[i,j]<>0) then
begin
t[i,j] := g[i,j];
t[j,i] := g[j,i];
try(j);
end;
end;

procedure khungsau;
var i,j: integer;
begin
fillchar(ctham,MAX,true);
for i:=1 to n do
for j:=1 to n do
t[i,j] := 0;
try(1);
hien(t);
end;
3. 2. Dựng cây khung theo chiều rộng
procedure khungrong;
var i,j: integer;
begin
for i:=1 to n do
for j:=1 to n do
t[i,j] := 0;
fillchar(ctham,MAX, true);
d := 1; c := 0;
ctham[1]:= false;
c := c+1; s[c] := 1;
while d<=c do
begin
i := s[d];
inc(d);
for j:=1 to n do
if (g[i,j]<>0)and ctham[j] then
begin
ctham[j] := false;
t[i,j] := g[i,j];

t[j,i] := g[j,i];
inc(c);
s[c] := j;
end;
end;
hien(t);
end;
3. 3. Thuật toán Kruskal
{Cấu trúc lưu trữ khác của Đồ thị}
Type canh = record
u,v,ts: integer;
end;
dothi = array[1..200] of canh;
var g: dothi;
a: mang;
n: integer; {so dinh}
m: integer; {so canh}
tr : mang1;
nap : mang2;
{Dựng đồ thị G (mảng các cạnh) từ đồ thị A}
procedure dung_dothi(a: mang);
var i,j: integer;
begin
m := 0;
for i:= 1 to n do
for j:= 1 to n do
if a[i,j] <> 0 then
begin
inc(m);
g[m].u := i;

g[m].v := j;
g[m].ts := a[i,j];
end;
end;
{Sắp xếp G tăng dần theo khoá TS}
procedure sapxep;
var tg: canh;
i,j,c: integer;
begin
for i:=1 to m-1 do
begin
c := i;
for j:= i+1 to m do
if g[c].ts > g[j].ts then
c := j;
if c <> i then
begin
tg := g[c];
g[c] := g[i];
g[i] := tg;
end;
end;
end;
{Tìm gốc của cây chứa N}
function goc(n: integer): integer;
begin
while tr[n] > 0 do
begin
n := tr[n];
end;

goc := n;
end;
CẤU TRÚC ĐỒ THỊ
Laptrinh_Hieu
22
{Thuật toán tìm cây khung cực tiểu}
procedure kruskal;
var i,u,v,dem: integer;
begin
for i:=1 to n do
begin
tr[i] := -1;
nap[i] := false;
end;
sapxep;
dem := 0;
for i:=1 to m do
begin
u := goc(g[i].u);
v := goc(g[i].v);
if u <> v then {Không tạo chu trình}
begin
nap[i] := true; {nạp vào cây}
tr[u] := v; {đưa vào 1 gốc}
dem := dem + 1;
if dem = n - 1 then
break;
end;
end;
writeln('CAY KHUNG CUC TIEU');

for i:=1 to m do
if nap[i] then
begin
write(g[i].u,’ ’);
write(g[i].v,’ ’);
writeln(g[i].ts);
end;
end;
IV. Các bài toán ứng dụng
4. 1. Bao đóng truyền ứng
{Thuật toán để kiếm tra giũa 2 đỉnh I,J có tồn
tại đường đi hay không?}
procedure baodong;
var i,j,k: integer;
begin
for i:= 1 to n do
for j:= 1 to n do
for k:= 1 to n do
if (g[i,j] <> 0) or
((g[i,k]<>0)and (g[k,j]<>0)) then
t[i,j] := 1;
end;
4. 2. Một nguồn mọi đích
{Tìm đỉnh u có d[u] nhỏ nhất và u chưa được
thăm}
function find_min: integer;
var u,i,min: integer;
begin
min := 32000;{ vo cung }
u := 0;

for i:=1 to n do
if (nap[i] = false) and (d[i] <
min) then
begin
min := d[i];
u := i;
end;
find_min := u;
end;
{Bài toán một nguồn mọi đích}
procedure dijstra(s: integer);
var i,j,dem,tong: integer;
begin
{khởi tạo ma trận trọng số}
for i:=1 to n do
for j:=1 to n do
if a[i,j] <> 0 then
c[i,j] := a[i,j]
else
c[i,j] := 32000; {vocung}
for i:=1 to n do
begin
d[i] := c[s,i];
nap[i] := false;
tr[i] := s;
end;
d[s] := 0;
repeat
i := find_min;
writeln('min = ',i);

if (i = 0) then {không tìm thấy}
break; {thoát lặp}
nap[i] := true; {thăm}

for j:=1 to n do {sửa lại d[j]}
if (nap[j] = false) and
(d[j] > d[i] + c[i,j]) then
begin
tr[j] := i;
d[j] := d[i] + c[i,j];
end;
until false;
end;
CẤU TRÚC ĐỒ THỊ
Laptrinh_Hieu
23
{In đường đi ngắn nhất từ S

T}
procedure inkq(t: integer);
var i,dem: integer;
begin
if d[t] = 32000 then
writeln('khong co ddi toi ',t)
else
begin
i := t;
dem := 1;
kq[1] := t;
while i <> s do

begin
dem := dem +1;
kq[dem] := tr[i];
i := tr[i];
end;
writeln('Trong so = ',d[t]);
for i:= dem downto 1 do
write(kq[i],' -> ');
writeln;
end;
end;
4. 3. Sắp xếp Tôpô
{Đồ thị với cấu trúc lưu trữ móc nối}
Type tronut = ^nut; type
nut = record
info: integer;
next: tronut;
end;
dothi = array[1..100] of tronut;
var V: dothi; g: mang;
{Nạp cung (i,j) vào đồ thị}
procedure nap(i,j: integer);
var p: tronut;
begin
new(p);
p^.info := j;
p^.next := V[i]^.next;
V[i]^.next := p;
V[j]^.info := V[j]^.info + 1;
end;

{Tạo đồ thị dạng danh sách lân cận từ ma trận
kề }
procedure tao_dothi;
var i,j: integer;
begin
for i:=1 to n do {Khởi tạo đồ thị rỗng}
begin
new(V[i]);
V[i]^.info := 0;
V[i]^.next := nil;
end;
for i:= 1 to n do
for j:= 1 to n do
if g[i,j] <> 0 then {tồn tại cung}
begin
nap(i,j);
end;
end;
{Sắp xếp theo thứ tự tôpô}
procedure topo;
var p: tronut;
i,m: integer;
begin
repeat
{Tìm đỉnh không có cung đến}
m := 0;
for i:= 1 to n do
if V[i]^.info = 0 then
begin
m := i;

break;
end;
if m <> 0 then
begin
V[m]^.info:=-1;{đánh dấu thăm}
write(m,' ');
{ Xoá các cung đi từ m}
p := V[i]^.next;
while p<> nil do
begin
dec(V[p^.info]^.info);
p:= p^.next;
end;
end;
until m = 0;
end;
1
1
2
3
4
5
2
1
6
5
1
4