Đệ quy: Procedure duyetGTP root: trocay; Begin If root nil then Begin Writeln root^.info; duyetGTP root^.left; duyetGTP root^.Right; end; end; Không đệ quy: Sử dụng kiểu con trỏ
Trang 1Đệ quy:
Procedure duyetGTP (root:
trocay);
Begin
If root <> nil then
Begin
Writeln (root^.info);
duyetGTP (root^.left);
duyetGTP
(root^.Right);
end;
end;
Không đệ quy: ( Sử dụng kiểu
con trỏ)
Procedure duyetGTP(root: trocay);
Var p: Trocay;
Begin
Push (stack, root); {đẩy root
vào stack}
While stack <> ϕ do
Begin
P:= pop(stack);
Writeln (P^.info);
If p^.right <>nil then
push(stack, p^.right);
If p^.right <>nil then
push(stack, p^.left);
End;
Duyệt cây theo thứ tự
giữa(TGP):
Đệ quy:
Procedure duyetTP (root: trocay);
Begin
If root <> nil then
Begin
duyetTGP (root^.left);
Writeln (root^.info);
duyetTGP (root^.Right);
end;
end;
Không đệ quy: ( Sử dụng kiểu
con trỏ)
Procedure duyetTGP(root: trocay);
Var p: Trocay;
Begin
Repeat
While root <>nil do
Begin
Push (stack, root);
P:=p^.left;
End;
If stack <> ϕ then
Begin
P:= pop(stack);
Writeln (P^.info);
P: p^.right;
End;
Until ( stack = ϕ) and (root = nil);
End;
Đếm số nút một cây
function sonut(t:trocay):integer;
var
begin
if (t=nil) then sonut:=0 else
if (t^.left =nil) and
(t^.right=nil) then sonut:=1 else
sonut:=1+sonut(t^.left) +
sonut(t^.right)
end;
Đếm số nút bậc 1 một cây
function sonut1(t:trocay):integer;
var
begin
if (t=nil) then sonut:=0 else
if (t^left <>nil) and
(t^right<>nil) then sonut:=0 else
if (t^left <>nil) and
(t^right=nil) then
sonut:=1+sonut(t^left)
else sonut:=1+
sonut(t^right)
end;
Đếm số nút bậc 2 một cây
function sonut2(t:trocay):integer;
var begin
if (t=nil) then sonut2:=0 else
if (t^.left =nil) or (t^.right=nil) then sonut2:=0 else sonut2:=1+sonut2(t^.left) + sonut2(t^.right)
end;
Đếm số nút lá một cây
function sonutl(var t:trocay):integer;
var begin
if (t=nil) then sonutl:=0 else
if (t^left =nil) and (t^right=nil) then sonutl:=1 else sonutl:=1+sonutl(t^left) + sonutl(t^right)
end;
Tính mức 1 nút trên cây:
* Đệ quy:
function dequy(root);
begin muc[root]:=1;
if root^info =x then return muc[root];
if roo^left <> nil then return dequy(root^left)+1;
if roo^right <> nil then return dequy(root^right)+1;
end;
* Không đệ quy:
function kdequy(root);
begin pushQ(root);
while Q<>Φ do begin u:=pop(Q);
if u^info =x then return muc[u];
if u^left<>nil then begin
push(Q,u^left);
muc[u^left]:=muc[u]
+1;
if u^rught<>nil then begin
push(Q,u^right);
muc[u^right]:=muc[u]+1;
end;
Tìm nút có giá trị x:
* đệ quy:
Function tim(root,x):boolean;
Begin
If root^info=x then return true;
If root=nil then return false;
If root^info<x then return tim(root^right,x);
If root^info>x then return tim(root^left,x);
End;
* Không đệ quy:
Function tim(root,x):boolean;
Begin While root <>nil do
If root^info=x then root:=root^left
Else root:=root^right;
Return (root<>nil);
End;
Thêm 1 nút vào cây nhị phâm
tìm kiếm
Procedure them(x:info;var p:ref);
var begin
if p=nil then begin
new(p);
p^info:=x;
p^.left =nil;
p^right=nil;
end else
if x<p^info then them(x, p^left) else if x>p^info then
them(x, p^right) end;
Chuyển cây nhị phân thành cây nhị phân tìm kiếm:
Procedure sapxep(var: M:day;
var: n:integer);
Var Begin
For i:=1 to n-1 do For j:=i+1 to n-1 do
If M[i]>M[j] then Begin
Tg:=M[i];
M[i]:=M[j];
M[j]:=tg;
End;
Procedure chuyen(root:trocay);
Begin
N:=0;
DuyetTGP(root,M,n,true);
Sapxep(M,n);
N:=0;
duyetTGP(root,M, n,false);
end;
Tìm kiếm nhị phân
* Đệ quy:
function tim(a:day;
l,r,x:integer):integer;
var Begin
if l>r then t:=0 else Begin
J:=(l+r) div 2;
If x< a[j].key then t:=tim(a,j+1,r,x) Else t:=j;
End;
Tim:=t;
End;
* Không đệ quy:
function tim(a:day;
l,r,x:integer):integer;
var begin found:=false;
l:=1; r:=n;
while (l<=r) and (not found) do begin
j:=(l+r) div 2;
if a[j].key =x then found:=true else
if x<a[j].key then
r:=j-1 else l:=j+r:=j-1;
end;
if found then tim:=j else tim:=0;
end;
SẮP XẾP BẰNG PHƯƠNG
PHÁP LỰA CHỌN
procedure select-sort(var a:day; n:integer);
var Begin for i:=1 to n-1 do begin
m:=i for j:=i+1 to n do
if a[j]<a[m] then m:=j;
if m<> I then begin x:=a[i]; a[i]:=a[m]; a[m]:=x; end;
end;
SẮP XẾP THEO KIỂU CHÈN
procedure insert-sort(var a:day; n:integer);
var begin for i:=2 to n do begin
x:=a[i]; a[0]:=x; j:=i-1; while x<a[i] do begin a[j+1]:=a[j]; j:=j-1;
end;
a[j+1]:=x;
end;
sắp xếp theo kiểu đổi chỗ:
Procedure buble-sort (var a:day; n: integer);
Var i,j,x: integer;
Begin For i:=2 to n do For j:=n downto i do
If a[j-1]> a[j] then Begin
X:=a[j-1];
a[j-1]:=a[j];
a[j]:=x;
end;
end;
Đồ Thị
Trang 2Duyệt rộng:
Procedure duyetrong (u);
Begin
PushQ (Q,u);
Chuatham[u]:= false;
While Q< >∅ do
Begin
U:=popQ(Q);
For v:=1 to n do
If chuatham[v] and ke[u,v] <
>0 then
Begin
PushQ(Q,v);
Chuatham [v]:=false;
End;
End;
Duyệt sâu dùng đệ qui:
Procedure duyetsau(u);
Begin
Chuatham[u]:=false;
Tham(u);
For v:=1 to n do n
If chuatham[v] and ke[u,v] < >0
then duyetsau(v);
End
Duyệt sâu không đệ qui:
Procedure DFS;
Var mark:array [1 max] of
integer;
I:integer;
Procedure visit (k:integer);
Begin
Write (k:5);
Mark[k]:=1;
For t:=1 to v do
If (a[k,t]=1) and (mark[t]=0)
then visit(t);
End;
Begin
For i:=1 to v do mark[i]:=0;
For i:=1 to v do if mark[i] then
visit(i);
End;
Đếm thành phần liên thông:
Function Demtplt : byte;
Begin
Dem:=0;
For i:=1 to n do
If chuatham[i] then
Begin
Dem:=dem+1;
Duyetrong(i);
End;
Demtplt:=dem;
End
Procedure demtplt;
Var
Begin
For k:=1 to v do mark[k]:=0;
Dem:=0;
For k:=1 to v do
If mark[k] = 0 then
Begin
Dem:=dem+1;
Write(‘thanh phan lt
thu’,dem,’gom’);
Visit(k);
End;
End;
Kiểm tra đồ thị có liên thông không:
Function tplt( ):boolean;
Var Begin For k:=1 to v do mark[k]:=0;
Dem:=0;
For k:=1 to v do
If mark[k] = 0 then Begin
Dem:=dem+1;
Visit(k);
End;
If (dem>=2) then tplt:=false else tplt:=true;
End;
Kiểm tra đồ thị có đường đi từ st không:
Procedure ketqua;
Var Begin
If truoc[t]=0 then writeln(‘không
co duong di’) else Begin J:=t;
Write(t, ‘’);
While truoc[j]<>s do Begin
Write ( truoc[j], ‘’);
J:=truoc[j];
End;
Write (‘co duong di’);
End;
Procedure duongdi;
Var Begin Write (‘tim duong di tu dinh:’);
readln(s);
Write (‘den dinh:’); readln(t);
For j:=1 to v do Begin
Truoc[j]:=0;
Mark[j]:=0;
End;
Duyetsau;
Ketqua;
End;
Danh sách liên kết đơn
Tạo danh sách:
Procedure TaoDS ( var L: tronut;
n: byte);
Var P, Q: tronut; i: byte;
Begin For i: = 1 to n do Begin
New(P);
Writeln( ‘ Nhap thong tin cua nut:’ );
Readln ( P^.info);
P^.link := Nil;
If L=Nil then L:= P Else q^.link := p;
q:=p;
End;
End;
Duyệt danh sách:
Procedure InDS ( L: tronut);
Var P:tronut;
Begin
P := L;
While P< > Nil do Begin
Write (P^.info: 5);
P := P^.link;
End;
End;
Tìm phần tử bé nhất trong danh sách:
Function TimMin ( L : tronut ) : integer;
Var P : tronut; min:integer;
Begin P:=L;
Min := P^.info;
While P < > Nil do Begin
If Min > P^.info then Min := P^.info;
P := P^.link;
End;
Timmin:=min;
End;
Tính tổng các phần tử dương:
Function TongDuong ( L : tronut ) :integer;
Var P : tronut ; Begin
P := L;
S:= 0;
While P< > Nil do Begin
IF P^ info > 0 then S:= S+
P^.info;
P := P^.link;
End;
TongDuong := S;
End;
Tìm phần tử dương đầu tiên:
Function PtuDuong (L : tronut ) : tronut ;
Var P : tronut ; Begin
P := L;
While (P< > Nil) and (P^.info<=0)
do P:= P^.link;
PtuDuong:= P;
End;
Tìm giá trị dương bé nhất trong danh sách:
Function MinDuong (L : tronut ) : integer ; Var P : tronut ; Begin
P := PtuDuong(L);
IF P=Nil then Minduong := 0
Else Begin Min := P^.info;
P:= P^.link;
While P < > Nil do Begin
IF ( Min>P^.info) and (P^.info
> 0 ) then Min:= P^.info;
P := P^.link;
End;
End;
MinDuong := Min;
End;
Bổ sung 1 nút vào cuối danh sách:
Procedure BoSung ( var L: tronut ; x : integer) ; Var P, Q : tronut;
Begin New (P);
P^.info:= x;
P^.link:= Nil;
If L=Nil then L:= P Else
Begin Q:= L;
While Q^.link < > nil do Q:= Q^ link;
Q^.link:= P;
End;
End;
Chèn 1 nút vào sau nút đang được trỏ M:
Procedure Chensau ( L, M : tronut ; x: integer);
Var P, Q: tronut ; Begin
New (P);
P^.info := x;
P^.link := M^.link; M^.link := P;
End;
Chèn vào trước nút trỏ bởi M:
Procedure Chentruoc ( var L : tronut ; M:tronut; x: integer); Var P, Q: tronut ; Begin
New (P);
P^.info := x;
P^.link := M;
If M=L then L:=P Else
Begin Q:=L;
While Q^.link < > M do Q:=Q^.link;
Q^.link:=P;
End;
End;
Xóa nút trỏ bởi M:
Procedure Xoa ( var L : tronut ; M: tronut; x: integer);
Var P: tronut ; Begin
If M=L then L:=L^.link Else
Begin P:=L;
While P^.link < > M do P:=P^.link;
P^.link:=M^.link;
End;
Dispose(M);
Nối danh sách 2 vào cuối danh sách 1:
Trang 3Procedure NoiDS ( var L1, L2 :
tronut );
Var P: tronut ;
Begin
If L1=Nil then L1:=L2
Else Begin
P:=L1;
While P^.link < > Nil do
P:=P^.link;
P^.link:=L2;
End;
Nối L2 vào sau nút trỏ m của L1:
Procedure Noi ( M, L1 : tronut
;L2: tronut);
Var P: tronut ;
Begin
P:=L2;
While P^.link < > Nil do
P:=P^.link;
P^.link:=M^.link;
M^.link:= L2;
End;
14 Sắp xếp danh sách theo thứ
tự giảm dần:
Procedure Sapxep ( var L :
tronut);
Var P, Q: tronut ;
Begin
P:=L;
While P^.link < > Nil do
Begin
Q:=Q^.link;
While Q < > Nil do
Begin
If P^.Info > Q^.info then
Begin
TG:= P^.info;
P^.info:=Q^.info;
Q^.info:=TG;
End;
Q:=Q^.link;
End;
P:=P^.link;
End;
Xóa nút có giá trị x:
Procedure Xoa ( var L : tronut ; n:
integer);
Var P,q: tronut ;
Begin
P:=L;
While (p<>nil) and (P^ info<>n)
do
Begin
Q:=p;
P:=p^.next;
End;
If p<>nil then
Begin
If p=L then L:=L^next else
Q^next:=p^next;
Dispose(p);
End;
Tìm độ dài dãy con tăng liên tiếp
lớn nhất trong danh sách L
Function dodai(L:tronut):integer;
Begin
Dem:=1;
Max:=1;
P:=L^next;
While L<>nil do
Begin
If (L^info < P^info) then
dem:=dem+1 else
Begin
If max< dem then max:=dem;
Dem:=dem+1;
End;
L:=p; p:=p^next;
End;
If max < dem then max:=dem;
Dodai:=max;
DANH SÁCH LIÊN KẾT VÒNG
TẠO DANH SÁCH
Procedure danhsach(var L:tronut;n:integer);
Var p, q: tronut;
Begin For i:=1 to n do Begin New(p);
Write(‘nhap thong tin’);
Readln(p^info);
If L=nil then q:=p Else p^.link:=L;
L:=p;
q^.link:=L;
end;
end;
DUYỆT DANH SACH
Procedure inDS (L:tronut);
Var p:tronut;
Begin P:=L;
Repeat Write (p^info:5);
P:=p^link;
Until p=L;
End;
TÌM PHẦN TỬ LỚN NHẤT
Function timmax(L:tronut):integer Var p, q:tronut; max:integer;
Begin Max:=L^.info;
P:=p^.link;
Repeat
If max<p^.info then max:=p^.info;
P:=P^.link;
Until p=L;
Timmax:=max;
End;
TÌM PHẦN TỬ CÓ GIÁ TRỊ X ĐẦU TIÊN
Function timx(L:tronut):tronut;
Var p:tronut;
Begin P:=L;
Repeat
If p^.info <> x then p:=p^.link;
Until (p^.info=x) or (p=L);
If p^.info=x then timx:=p Else timx:=nil;
End;
BỔ SUNG NÚT X VÀO CUỐI DANH SÁCH
Procedure bosung(var L:tronut, x:integer);
Var p, q:tronut;
Begin New (p); p^.info:=x; p^.link:=L;
If L<> nil then Begin Q:=L;
While q^.link<>L do q:=q^.link;
q^.link:=p;
end else begin L:=p; p^.link:=L;
End;
CHÈN PHẦN TỬ SAU M
Procedure chensauM(var L:tronut;m:tronut;x:integer);
Var p:tronut;
Begin New(p);p^.info:=x;
P^.link:=M^.link;
M^.link:=p;
End;
XÓA TẠI VỊ TRÍ M
Procedure XoaM(var L:tronut,M:tronut);
Var p: tronut;
Begin
If M=L then
If L=L^.link then L:=nil Else
Begin L:=L^.link;
P:=L;
While p^.link <> L do P:=P^.link;
P^.link:=L;
End;
Else Begin P:=L;
While P^.link <>M do P:=P^.link;
P^.link:=M^.link;
End;
Dispose(m);
End;
NỐI HAI DANH SÁCH
Procedure noids(var L1:tronut, L2:tronut);
Var p:tronut;
Begin
If L1=nil then L1:=L2 Else
Begin P:=L1;
While p^.link<>L1 do p:=p^.link;
P^.link:=L2;
P:=L2;
While p^.link <> L2 do P:=p^.link;
P^.link:=L1;
End;
End;
NỐI DANH SÁCH 2 VÀO DANH SÁCH 1 SAU M
Procedure NoisauM(var L1:tronut,L2, M:Tronut); Var p:Tronut;
Begin P:=L2;
While p^.link<>L2 do P:=p^.link;
P^.link:=M^.link;
M^.link:=L2;
End;
XÓA PHẦN TỬ ĐẦU TIÊN CÓ GIÁ TRỊ BẰNG X TRONG L
Procedure Xoapt(var l:tronut,x:integer);
Var M:tronut;
Begin M:=timx(L,x);
If M<>nil then XoaM(L,M); End;