CẤU TRÚC CÂY
Laptrinh_Hieu
15
I. Cây nhị phân
1. 0. Khai báo
type cay = ^nut;
nut = record
info: integer;
trai, phai: cay;
end;
var t: cay;
1. 1. Dựng cây nhị phân
procedure chen(var t:cay;n:integer);
begin
if t = nil then
begin
new(t);
t^.info := n;
t^.trai := nil;
t^.phai := nil;
end
else
if n = t^.info then
writeln(n, ' da co')
else
if n > t^.info then
chen(t^.phai,n)
else chen(t^.trai,n);
end;
1. 2. Các phép duyệt cây đệ quy
procedure truoc(t: cay);

begin
if t<> nil then
begin
write(t^.info:3);
truoc(t^.trai);
truoc(t^.phai);
end;
end;
(***********************)
procedure giua(t:cay);
begin
if t<> nil then
begin
giua(t^.trai);
write(t^.info:3);
giua(t^.phai);
end;
end;
(***********************)
procedure sau(t:cay);
begin
if t<> nil then
begin
sau(t^.trai);
sau(t^.phai);
write(t^.info:3);
end;
end;
1. 3. Duyệt cây không đệ quy
type

mang1 = array[1..100] of cay;
mang2 = array[1..100]of byte;
var s: mang1;
r: mang2; {Stack để đánh dấu có được
{ phép thăm hay không}
ts,tr: integer;
(*****************)
procedure spush(var s:mang1;p: cay);
begin
ts := ts + 1;
s[ts] := p;
end;
(************)
function spop(var s: mang1) : cay;
begin
if ts>0 then
begin
spop := s[ts];
ts := ts -1;
end;
end;
(******************************)
procedure rpush(var r: mang2; n :
byte);
begin
tr := tr + 1;
r[tr] := n;
end;
(************)
function rpop(var r:mang2): byte;

var n: byte;
begin
if tr>0 then
begin
n := r[tr];
tr := tr - 1;
rpop := n;
end;
end;
procedure truoc(t: cay);
var p:cay;
CẤU TRÚC CÂY
Laptrinh_Hieu
16
begin
ts := 0;
p := t;
if t<> nil then
spush(s,p);
while ts>0 do
begin
p:= spop(s);
write(p^.info:3);
if p^.phai <> nil then
spush(s,p^.phai);
if p^.trai <> nil then
spush(s,p^.trai);
end;
end;
procedure Giua(t: cay);

var p:cay;
begin
ts := 0;
p := t;
repeat
{Nộp p cùng nhánh lệch trái vào Stack}
while (p<> Nil) do
begin
spush(S, p);
p:= p^.Trai;
end;
p:= spop(S);{Lấy p ra từ Stack}
write(p^.info:3); {Thăm p}
p:= p^.Phai; {sang con phải của p}
until (ts = 0) and (p = Nil);
end;

procedure sau(t: cay);
var p:cay;
n: integer;
begin
ts := 0;
tr := 0; {khởi tạo 2 Stack rỗng}
p := t;
repeat
{Nộp p cùng nhánh lệch trái vào
Stack, nhưng sẽ chưa được phép thăm, R[tr] = 1}
while (p<> Nil) do
begin
SPUSH(S, p);

RPUSH(R, 1);
p:= p^.Trai;
end;
{lấy ra từ 2 Stack}
p:= SPOP(S);
n:= RPOP(R);
if (n = 1) and
(p^.Phai <> Nil) then
begin {sẽ được thăm sau, R[ts] = 2}
SPUSH(S, p);
RPUSH(R, 2);
P:= p^.Phai;
end
else {(n=2) or (p^.Phai = nil)

thăm}
begin
write(p^.info:3); {thăm}
p:= Nil;
end;
until (TS = 0) and (p = Nil);
end;
1. 4. Tính chiều cao của cây
function max(a,b: integer): integer;
begin
if a>b then max := a
else max := b;
end;
function chieucao(t:cay):integer;
begin

if t=nil then chieucao := 0
else
chieucao := 1 +
max(chieucao(t^.trai),
chieucao(t^.phai));
end;
1. 5. Đếm số đếm nút cành (~ toán tử)
function sonutcanh(t:cay):integer;
begin
if t= nil then sonutcanh:=0
else
if (t^.trai = nil) and
(t^.phai = nil) then
sonutcanh:=0
else
sonutcanh:=1 + sonutcanh(t^.trai) +
sonutcanh(t^.phai);
end;
procedure lietkecanh(t:cay);
begin
if t = nil then write(' ')
else
if (t^.trai <> nil) or
(t^.phai <> nil) then
begin
write(t^.info:3);
lietkecanh(t^.trai);
lietkecanh(t^.phai);
end;
end;

1. 6. Đếm số nút lá (~ toán hạng )
function sonutla(t:cay):integer;
begin
if t= nil then sonutla:=0
else
CẤU TRÚC CÂY
Laptrinh_Hieu
17
if (t^.trai=nil) and
(t^.phai=nil) then
sonutla:=1
else sonutla:= sonutla(t^.trai)+
sonutla(t^.phai);
end;
(***********************)
procedure lietkela(t:cay);
begin
if t = nil then write(' ')
else
if (t^.trai=nil) and
(t^.phai=nil) then
write(t^.info:3)
else
begin
lietkela(t^.trai);
lietkela(t^.phai);
end;
end;
II. Cây nhị phân tìm kiếm
2. 1. Tìm kiếm nút chứa khóa k.

Giải thuật đệ quy
function tim_dq(t:cay;k:Integer:cay;
begin
if (t=NIL) or (t^.info=k) then
tim_dq := t
else
if (T^.info < k) then
tim_dq:=tim_dq(T^.phai, k)
else
tim_dq:=tim_dq(T^.trai, k);
End;
Giải thuật lặp
Function Tim(T:cay;K:Integer):cay;
Var p: cay;
Begin
P:= T;
While (p<>Nil) and (p^.info<>k) do
If (p^.info < k) then
p:= p^.Phai
Else
P:= p^.Trai;
Tim:= p;
End;
2. 2. Loại bỏ một nút P
Giả sử P đã có trong cây.
Giải thuật đệ quy
Procedure LoaiBo(Var t:cay; p: cay);
Begin
If p = T Then
Begin {XOÁ GỐC}

If (p^.Trai = Nil) Then
t:= t^.Phai
Else
Begin
r:= T^.Trai;
While r^.Phai <> Nil Do
r:= r^.Phai;
R^.Phai:= T^.Phai;
T:= T^.Trai;
End;
Dispose(p);
End
Else {P không trùng gốc}
If (p^.info < T^.info) Then
LoaiBo(T^.Trai, p)
Else LoaiBo(T^.Phai, p);
End;
Giải thuật lặp
Procedure LoaiBo2(Var t:cay;p: cay);
Var q, r: cay;
Begin
q := t;
{TH: P trùng với GỐC

xoá gốc }
If (p = T) Then
begin
If (p^.Trai = Nil) Then
T:= p^.Phai
Else

Begin
r:= p^.Trai;
While (r^.Phai <> Nil) Do
r:= r^.Phai;
r^.Phai:= T^.Phai;
T:= p^.Trai;
End;
exit; {Thoát chương trình con}
end;
{TH: P <> GỐC

Tìm nút Q, mà:
Q^.Trai = P hoặc Q^.Phai = P}
While (q^.Trai <> p) and
(q^.Phai <> p) Do
begin
If (q^.info < p^.info) Then
q:= q^.Phai
Else q:= q^.Trai;
end;

{Điều chỉnh lại các con trỏ trên cây}
If p^.Trai = Nil Then {Cụt trái}
begin
If q^.Trai = p Then
q^.Trai:= p^.Phai
Else q^.Phai:= p^.Phai
end
CẤU TRÚC CÂY
Laptrinh_Hieu

18
Else {Cụt phải}
Begin
If (q^.Trai = p) Then
q^.Trai:= p^.Trai
Else q^.Phai:= p^.Trai;
R:= p^.Trai;
While (R^.Phai <> Nil) Do
R:= R^.Phai;
R^.Phai:= p^.Phai;
End; Dispose(p);
End;
2. 3. Bổ sung một nút mới
Procedure Bosung(T:cay; K:Integer);
Var p,r : cay; OK: Boolean;
Begin {1}
If (T = NIL) Then
Begin
New(T);
T^.info := k;
T^.Trai:= NIL;
T^.Phai:= NIL;
End
Else
Begin {2}
P:= T; OK:= True;
While (p^.info <>k) and OK do
If (p^.info > k) Then
If (p^.Trai<>NIL) Then
p:= p^.Trai

Else OK:= False
Else
If (p^.Phai<>NIL) Then
p:= p^.Phai
Else OK:= False;
If (p^.info = k) Then
Write(k,' da ton tai')
Else
Begin {3}
New(r);
R^.info:= k;
R^.Phai:= NIL;
R^.Trai:= NIL;
If (p^.info > k) Then
p^.Trai := r
Else p^.Phai:= r;
End; {3}
End; {2}
End; {1}
2. 4. Tìm nút cực đại (tận cùng phải)
function nutmax(t : cay):cay;
var p: cay;
begin
If t = nil then nutmax := nil
else
begin
p := t;
while p^.phai <> nil do
p := p^.phai;
nutmax:= p;

end;
end;
2. 5. Tìm nút cực tiểu (tận cùng trái)
function nutmin(t : cay):cay;
var p: cay;
begin
If t = nil then nutmin := nil
else
begin
p := t;
while p^.trai <> nil do
p := p^.trai;
nutmin:= p;
end;
end;
2. 6. Dựng cây nhị phân tìm kiếm
Cho danh sách tăng dần, dựng cây nhị phân
tìm kiếm cho danh sách đó, sao cho chiều cao
cây là nhỏ nhất.
procedure dung(var t:cay;
dau, cuoi: integer);
var m: integer;
begin
if dau <= cuoi then
begin
m := (dau + cuoi) div 2;
new(t);
t^.info := a[m]; {gốc của cây}
dung(t^.trai, dau, m-1);
dung(t^.phai, m+1, cuoi);

end;
end;

5
3 10
8 13
9
1
Để hiểu các thuật
toán thì cần phải
tự thực hiện
chương trình với
1 ví dụ cụ thể.