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;

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

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;

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

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];

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;

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;

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

{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;