CÂY
Đệ 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
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
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
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]
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
begin
a[j+1]:=a[j]; j:=j1;
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ị
Duyệ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:
Procedure 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:=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;