Code các kiểu dữ liệu trừu tượng - Pascal
Procedure InOrder(T:BSTree);
Var i:BSTree;
Begin
if T<>nil then
begin
InOrder(T^.Left); write(T^.key:3); InOrder(T^.Right);
end;End;
{---------- DUYET HAU TU --------}
Procedure PostOrder(T:BSTree);
Var i:BSTree;
Begin
if T<>nil then
begin
PostOrder(T^.Left); PostOrder(T^.Right); write(T^.key:3);
end;End;
23 trang |
Chia sẻ: lvcdongnoi | Lượt xem: 2946 | Lượt tải: 1
Bạn đang xem trước 20 trang tài liệu Code các kiểu dữ liệu trừu tượng - Pascal, để xem tài liệu hoàn chỉnh bạn click vào nút DOWNLOAD ở trên
CÁC KIỂU DỮ DIỆU TRỪU TƯỢNG
I. DANH SÁCH
{------------ THUC THI DANH SACH BANG MANG (DS DAC) ------------}
Uses CRT;
Const max=100;
Type
Datatype=integer;
List=record
data:array[1..max] of DataType;
Last:integer;
End;
Var L : List;i,n,x:integer;
{--------- TAO DANH SACH RONG --------}
Procedure Makenull(Var L: List);
Begin
L.Last:=0;
End;
{---------- KIEM TRA DANH SACH RONG --------}
Function Empty(L:List):boolean;
Begin
empty:=L.Last=0;
End;
{---------- KIEM TRA DANH SACH DAY ----------}
Function Full(L:List):boolean;
Begin
Full:=L.Last>max;
End;
{----------- TRA VE VI TRI PHAN TU SAU PT CUOI CUNG ------}
Function End_List(L:List): integer;
Begin
End_List:=L.Last+1;
End;
{---------- TRA VE VI TRI PHAN TU DAU TIEN -----------}
Function First(L:List):integer;
Begin
First:=1;
End;
{----------- TRA VE VI TRI PHAN TU SAU PHAN TU P ---------}
Function Next(P:integer;L:List):integer;
Begin
Next:=P+1;
End;
{----------- TRA VE VI TRI PHAN TU TRUOC PHAN TU P ---------}
Function Previous(P:integer;L:List):integer;
Begin
Previous:=P-1;
End;
{----------- TRA VE VI TRI PHAN TU CUOI CUNG ---------}
Function Last(L:List):integer;
Begin
Last:=L.Last;
End;
{---------- TIM PHAN TU CO GIA TRI LA X -----------}
Function Local(x:datatype;L:List):integer;
Var i,tim:integer;
Begin
tim:=0;
for i:=1 to L.Last do
if L.data[i]=x then tim:=i;
Local:=tim;
End;
{---------- THEM PHAN TU VAO DANH SACH TAI VI TRI P ----------}
Procedure Insert(x:integer;P:integer; Var L:List);
Var q:integer;
Begin
if Full(L) then writeln('Danh sach day!')
else
if (PL.Last) then writeln('P is out position!')
else
begin
For q:=L.Last+1 downto p+1 do
L.data[q]:=L.data[q-1];
L.Last:=L.Last+1;
L.data[p]:=x;
end;
End;
{------------ XOA PHAN TU TAI VI TRI P ----------}
Procedure Delete(p:integer;Var L:List);
Var i: integer;
Begin
if Full(L) then writeln('Danh sach day!')
else
if (PL.Last) then writeln('P is out position!')
else
begin
For i:=L.Last-1 downto p do
L.data[i]:=L.data[i+1];
L.Last:=L.Last-1;
end;
End;
{------------ LAY GIA TRI PHAN TU TAI VI TRI P -----------}
Function Retrieve(P: integer;L:List):integer;
Var i:integer;
Begin
if empty(L) then writeln('Danh sach rong!')
else
if (PL.Last) then writeln('P is out position!')
else
retrieve:=L.data[p];
End;
{----------------- THUC THI DANH SACH LIEN KET DON ----------- }
Uses CRT;
Type
datatype=integer;
List=^Cell;
Cell= Record
data:datatype;
next:List;
end;
Var L: List; x,n:integer;
{---------- TAO DANH SACH RONG ---------}
Procedure Makenull(Var L: List);
Begin
L^.next:=nil;
End;
{----------- KIEM TRA DANH SACH RONG --------}
Function Empty(L:List):Boolean;
Begin
empty:=L^.next=nil;
End;
{----------- TRA VE PHAN TU SAU PHAN TU P -----------}
Function Next(P:List;L:List):List;
Begin
Next:=P^.next;
End;
{------------ TRA VE PHAN TU DAU DANH SACH --------------}
Function First(L:List):List;
Var P: List;
Begin
if not empty(L) then
P:=L;
End;
{----------- TRA VE PHAN TU SAU PHAN TU CUOI DANH SACH ----------}
Function End_List(L:List):List;
Var P: List;
Begin
P:=L;
While P^.nextnil do P:=P^.next;
End_List:=P;
End;
{------------ TRA VE VI TRI PHAN TU TIM THAY --------}
Function Local(x:datatype;L:List):List;
Var P: List;
Begin
if empty(L) then Local:=nil
else
begin
P:=L;
while (P^.nextnil) do
begin
if P^.next^.data=x then Local:=p;
P:=P^.next;
end;
end;
End;
{------------ LAY GIA TRI TAI PHAN TU P -----------}
Function Retrieve(P:List;L:list):datatype;
Begin
if P^.nextnil then
Retrieve:=P^.next^.data;
End;
{------ THEM PHAN TU VAO VI TRI BAT KI TRONG DANH SACH ---------}
Procedure Insert_L(x:datatype;p:integer;Var L:List);
Var tam,Q:List;i:integer;
Begin
new(tam);tam^.data:=x;
tam^.next:=nil;Q:=L;
if P=1 then
begin
tam^.next:= Q^.next;
Q^.next:=tam
end
else
begin
For i:=2 to p do Q:=Q^.next;
tam^.next:=Q^.next;
Q^.next:=tam;
end;
End;
{------------ THEM 2 PHAN TU VAO DANH SACH DA DUOC SAP XEP --------}
Procedure Insert_L1(x:integer;Var L: List);
Var tam:integer;P,Q:List;
Begin
new(Q);
Q^.data:=x;
Q^.next:=nil;P:=L;
While (P^.nextnil) and (x>P^.next^.data) do P:=P^.next;
Q^.next:=P^.next;
P^.next:=Q;
End;
{-------------- XOA PHAN TU TAI VI TRI n TRONG DANH SACH -----------}
Procedure Delete(n:integer;Var L:List);
Var i: integer; P,P1:List;
Begin
if n=1 then
begin
P:=L;
P^.next:=P^.next;
end
else
begin
P:=L;
For i:=2 to n do P:=P^.next;
P^.next:=P^.next;
end;
P^.next:=P^.next^.next;
End;
{------------ SAP XEP DANH SACH --------}
Procedure SapXep(Var L: List);
Var P,Q: List; tam:integer;
Begin
P:=L;
while P^.nextnil do
begin
Q:=P^.next;
While Qnil do
begin
if P^.next^.data>Q^.next^.data then
begin
tam:=P^.next^.data;
P^.next^.data:=Q^.next^.data;
Q^.next^.data:=tam;
end;
Q:=Q^.next;
end;
P:=P^.next;
end;
End;
II- HÀNG ĐỢI
{---------------THUC THI HANG DOI BANG CON TRO ---------}
Uses CRT;
Type
elementype=integer;
Node=^Cell;
Cell= record
element:elementype;
next:Node;
end;
Queue=record
front,rear: Node;
end;
Var Q: Queue;x,m,n:integer;
{--------- TAO HANG RONG -----------}
Procedure Makenull(Var Q: Queue);
Begin
new(Q.front);
Q.front^.next:=nil;Q.front:=Q.rear;
End;
{-------- KIEM TRA HANG RONG--------}
Function Empty(Q:Queue):boolean;
Begin
empty:=Q.front=Q.rear;
End;
{---------- LAY NOI DUNG TAI VI TRI DAU HANG --------}
Function Front(Q:Queue):elementype;
Begin
if not empty(Q) then
front:=Q.front^.next^.element;
End;
{--------- XOA PHAN TU DAU HANG ------------}
Procedure DelQueue(Var Q: Queue);
Var T: node;
Begin
if not empty(Q) then
Q.front:=Q.front^.next;
End;
{---------- THEM PHAN TU VAO CUOI HANG -------- }
Procedure EndQueue(x:elementype;Var Q: Queue);
Begin
new(Q.rear^.next);
Q.rear:=Q.rear^.next;
Q.rear^.element:=x;
Q.rear^.next:=nil;
End;
{------------ THUC THI HANG DOI BANG MANG VONG ---------------}
Uses CRT;
Const max=100;
Type
elementype=integer;
Queue = Record
element:array[1..max-1] of elementype;
front,rear:integer;
end;
Var Q: Queue;x,m,n:integer;
{---------- TAO HANG RONG ----------}
Procedure Makenull(Var Q: Queue);
Begin
Q.front:=0;Q.rear:=0;
End;
{--------- KIEM TRA HANG RONG -------}
Function Empty(Q:Queue):Boolean;
Begin
empty:=Q.Front=Q.rear+1;
End;
{--------- KIEM TRA HANG DAY ---------}
Function Full_Q(Q:Queue):Boolean;
Begin
Full_Q:=Q.rear=max;
End;
{--------- THEM PHAN TU VAO CUOI HANG ----------}
Procedure EndQueue(x:elementype;Var Q: Queue);
Begin
if Full_Q(Q) then writeln('Hang day!')
else
begin
if Q.front=0 then
Q.front:=Q.front+1;
Q.rear:=Q.rear+1;
Q.element[Q.rear]:=x;
end;
End;
{--------- XOA PHAN TU RA KHOI HANG ---------}
Procedure DelQueue(Var Q: Queue);
Begin
if empty(Q) then writeln('Hang doi rong!')
else
Q.front:= Q.front+1;
End;
III- NGĂN XẾP:
{------------- THUC THI NGAN XEP BANG MANG -------------}
Uses CRT;
Const max = 100;
Type
Elementype=integer;
STACK=Record
element:array[1..max] of elementype;
Top:integer;
end;
Var S:Stack;x,n,m:integer;
{----------- TAO NGAN XEP RONG ----------}
Procedure Makenull(Var S: Stack);
Begin
S.Top:=max;
End;
{--------- KIEM TRA NGAN XEP RONG --------}
Function Empty(S:Stack):boolean;
Begin
empty:=S.Top=max;
End;
{---------- KIEM TRA NGAN XEP DAY ----------}
Function Full_Stack(S:Stack):boolean;
Begin
Full_Stack:=S.Top=0;
End;
{---------- THEM PHAN TU X LEN DINH NGAN XEP ----------}
Procedure Push(x:elementype;Var S:Stack);
Begin
if full_Stack(S) then writeln('Ngan xep day!')
else
begin
S.Top:=S.Top-1;
S.element[S.top]:=x;
end;
End;
{-------- TRA VE PHAN TU TREN DINH NGAN XEP -------}
Function TOP(S:Stack):elementype;
Begin
if empty(S) then writeln('Ngan xep rong!')
else
Top:=S.element[S.top];
End;
{---------- XOA PHAN TU O DINH NGAN XEP ---------}
Procedure POP(Var S: stack);
Begin
if empty(S) then writeln('Ngan xep rong!')
else
S.Top:=S.Top+1;
End;
{------------- THUC THI NGAN XEP BANG CON TRO -------------}
Uses CRT;
Type
elementype=integer;
Stack=^Node;
Node=Record
element:elementype;
Link:Stack;
end;
Var S: Stack; x,m,n:integer;
{----------- TAO STACK RONG ----------}
Procedure Makenull(Var S: Stack);
Begin
S:=nil;
End;
{---------- KIEM TRA RONG ---------}
Function Empty(S:Stack):boolean;
Begin
empty:=S=nil;
End;
{--------- THEM PHAN TU ---------}
Procedure Push(x:elementype;Var S:Stack);
Var P: Stack;
Begin
new(P);P^.element:=x;
P^.link:=S;S:=P;
End;
{----------- XOA PHAN TU TAI DINH NGAN XEP --------}
Procedure POP(Var S: Stack);
Var P: Stack;
Begin
if empty(S) then writeln('ngan xep rong!')
else
begin
P:=S^.link;
dispose(S);
S:=P;
end;
End;
IV- CÂY TỔNG QUÁT:
{------------- THUC THI CAY TQ BANG MANG -------------}
Uses CRT;
Const max=100;
Type
elementype= char;
Node=integer;
Tree= record
parent:array[1..max] of node;
labell:array[1..max] of elementype;
max_node:node;
end;
Var T: Tree;i:node;
{--------- TAO CAY RONG --------}
Procedure Makenull(Var T:Tree);
Begin
T.max_node:=0;
End;
{-------- KIEM TRA CAY RONG -------}
Function Empty(T:Tree):boolean;
Begin
empty:=T.max_node=0;
End;
{--------- TIM CHA CUA NUT N --------}
Function Parent(n: node; T: Tree):node;
Begin
if empty(T) then writeln('Cay rong!')
else
parent:=T.parent[n];
End;
{-------- XAC DINH NUT GOC CUA CAY ---------}
Function ROOT(T:Tree):node;
Begin
if empty(T) then writeln('Cay rong!')
else ROOT:=1;
End;
{-------- NHAN CUA NUT N ---------}
Function Label_T(n:node; T: Tree):elementype;
Begin
if empty(T) then writeln('Cay rong!')
else
Label_T:=T.labell[n];
End;
{------- TIM CON TRAI CUA NUT N --------}
Function Leftmost_child(n:node;T:Tree):node;
Var i:node;
Begin
if empty(T) then Leftmost_child:=0
else
begin
i:=n+1;
while (T.parent[i]n) and (i<=T.max_node) do
i:=i+1;
if T.parent[i]=n then Leftmost_child:=i
else
if i>T.max_node then Leftmost_child:=0;
end;
End;
{---------- ANH EM BEN PHAI CUA NUT N ----------}
Function Right_Sibling(n:node;T:Tree):node;
Var i: node;
Begin
if empty(T) then Right_Sibling:=0
else
begin
i:=n+1;
while (T.parent[i]T.parent[n]) and (i<=T.max_node) do
i:=i+1;
if T.parent[i]=T.parent[n] then Right_Sibling:=i
else
if i>T.max_node then Right_Sibling:=0;
end;
End;
{----------- DUYET CAY THEO PA TIEN TU --------}
Procedure PreOrder(n:node;T:Tree);
Var i:node;
Begin
write(label_T(n,T));
i:=Leftmost_child(n,T);
while i0 do
begin
n:=i;
Preorder(n,T);
i:=right_sibling(n,T);
end;
End;
{------------ DUYET TRUNG TU -----------}
Procedure InOrder(n:node;T:Tree);
Var i: node;
Begin
i:=leftmost_child(n,T);
if i0 then Inorder(i,T);
write(Label_T(n,T));
i:=right_sibling(i,T);
while i0 do
begin
n:=i;
inOrder(n,T);
i:=Right_sibling(n,T);
end;
End;
{--------- DUYET HAU TU ----------}
Procedure PostOrder(n:node;T:Tree);
Var i: node;
Begin
i:=leftmost_child(n,T);
while i0 do
begin
PostOrder(i,T);
i:=right_sibling(i,T);
end;
write(label_T(n,T));
end;
{------------- DO SAU CUA NUT N -----------}
Function DoSau(n:node;T: Tree):integer;
Var i: node;dem:integer;
Begin
i:=T.parent[n]; dem:=0;
while iRoot(T) do
begin
i:=T.parent[i]; dem:=dem+1;
end;
DOSAU:=DEM+1;
End;
{------------ BAC CUA NUT ---------}
Function Bac_Node(n:node;T: Tree):integer;
Var i:node; kq:integer;
Begin
kq:=0;
i:=Leftmost_child(n,T);
while i0 do
begin
kq:=kq+1;
i:=right_sibling(i,T);
end;
Bac_node:=kq;
End;
{------------ BAC CUA CAY ---------}
Function Bac_Tree(T: Tree):integer;
Var i:node; kq:integer;
Begin
kq:=bac_node(Root(T),T);
for i:=1 to T.max_node do
if kq<bac_node(i,T) then
kq:=bac_node(i,T);
Bac_Tree:=kq;
End;
{------------ CHIEU CAO CUA CAY -----------}
Function Maxx(a,b:integer):integer;
Begin
if a>b then maxx:=a else maxx:=b;
End;
Function Height(n:node;T:Tree):integer;
Var kq:integer;i:node;
Begin
if empty(T) then kq:=0
else
begin
i:=leftmost_child(n,T);
while i0 do
begin
kq:=maxx(kq,height(i,T));
i:=right_sibling(i,T);
end;
end;
height:=kq+1;
end;
{---------- KIEM TRA NUT LA -------}
Function LA(n:node;T:Tree):boolean;
Var i: node;
Begin
i:=n+1;
while (T.parent[i]n) and (i<=T.max_node) do i:=i+1;
if T.parent[i]=n then LA:=false
else
if i>T.max_node then LA:=True;
End;
{------------ SO NUT LA TRONG CAY -----------}
Function Number_La(T:Tree):integer;
Var i: node; kq: integer;
Begin
kq:=0;
if empty(T) then kq:=0
else
For i:=1 to T.max_node do
if La(i,T) then kq:=kq+1;
Number_La:=kq;
End;
{-------------- NHAP CAY ----------}
Procedure Read_Tree(Var T:Tree);
Var m,i:integer;
Begin
while (mmax) do
begin
write('- Nhap so nut trong cay tong quat: ');
readln(m);
end;
writeln; T.max_node:=m;
For i:=1 to m do
begin
writeln('- Nhap thong tin cho nut thu:' ,i,': ');
write(' + Nhan ',i,': ');readln(T.labell[i]);
write(' + Cha cua nut: ');readln(T.parent[i]);
end;
End;
{---------- THUC THI CAY BANG DANH SACH CAC CON ----------}
Uses CRT;
Const max_node=50;
Type
labeltype=char;
node=integer;
List= record
element:array[1..max_node] of node;
Last:node;
end;
Tree=Record
Header: array[1..max_node] of List;
Labell: array[1..max_node] of LabelType;
Root: node;
end;
Var T: Tree;
{----------- TAO DANH SACH RONG -------}
Procedure Makenull_L(Var L:List);
Begin
L.Last:=0;
End;
{--------- KIEM TRA DANH SACH RONG ------}
Function Empty_L(L:List):boolean;
Begin
empty_L:=L.Last=0;
End;
{--------- PHAN TU DAU DANH SACH -------}
Function First(L:List):node;
Begin
First:=1;
End;
{--------- PHAN TU CUOI DANH SACH -------}
Function End_L(L:List):node;
Begin
End_L:=L.Last+1;
End;
{---------- LAY GIA TRI TAI VI TRI P TRONG DS --------}
Function Retrieve(p:integer;L:List):node;
Begin
if not empty_l(L) then retrieve:=L.element[p];
End;
{---------- TIM PHAN TU CO GIA TRI LA X -----------}
Function Local(x:node;L:List):boolean;
Var i:integer;tim:boolean;
Begin
tim:=false;
for i:=1 to L.Last do
if L.element[i]=x then tim:=true;
Local:=true;
End;
{----------- TAO CAY RONG ----------}
Procedure Makenull_T(Var T: Tree);
Begin
T.root:=0;
End;
{---------- KIEM TRA CAY RONG ----------}
Function Empty_T(T:Tree):boolean;
Begin
empty_T:=T.root=0;
End;
{---------- NHAN CUA NUT ---------}
Function Labell(n:node;T:Tree):labeltype;
Begin
Labell:=T.labell[n];
End;
{----------- TIM CHA CUA NUT N ------------}
Function Parent(n:node;T:Tree):integer;
Var L: List ;i,j:integer;
Begin
if empty_T(T) then writeln('Cay rong!')
else
if n=1 then parent:=-1
else
begin
i:=1;
while i<T.root do
begin
L:=T.header[i];
if not empty_L(L) then
begin
j:=1;
while (jn) do j:=j+1;
if L.element[j]=n then
begin
parent:=i;
i:=i+T.Root;
end
else
end;
i:=i+1;
end;
end;
End;
{----------- GOC CUA CAY --------------}
Function ROOT(T:Tree):integer;
Var i,k:node;L:List; dem:integer;
Begin
k:=1;
while parent(k,T) -1 do k:=k+1;
Root:=k;
End;
{----------- CON TRAI CUA NUT ---------}
Function Leftmost_Child(n:node; T:Tree):node;
Var L: List;
Begin
if empty_T(T) then writeln('Cay rong!')
else
begin
L:=T.header[n];
if empty_L(L) then Leftmost_child:=0
else
Leftmost_child:=retrieve(first(L),L);
end;
End;
{--------- ANH EM BEN PHAI CUA NUT ------------}
Function Right_Sibling(n:node; T:Tree):node;
Var L: List;cha:integer;
Begin
if empty_T(T) then writeln('Cay rong!')
else
begin
cha:=parent(n,T);
L:=T.header[cha];
if empty_L(L) then Right_sibling:=0
else
Right_sibling:=retrieve(first(L)+1,L);
end;
End;
{------------ KIEM TRA NUT LA ------------}
Function LA(n:node;T:Tree):boolean;
Var L: List;
Begin
L:=T.header[n];
if empty_L(L) then La:=true
else La:=False;
End;
{------------- SO NUT LA TRONG CAY -----------}
Function Number_La(T:Tree):integer;
Var dem:integer;L:List;i:node;
Begin
dem:=0;
i:=1;
while i<=T.root do
begin
L:=T.header[i];
if empty_L(L) then dem:=dem+1;
i:=i+1;
end;
Number_La:=dem;
End;
{----------- DO SAU CUA MOT NUT -----------}
Function Dosau(n:node;T:Tree):integer;
Var i,dem: integer; L : List;
Begin
if n=1 then dem:=0
else
begin
i:=parent(n,T);
while i-1 do
begin
i:=parent(i,T);dem:=dem+1;
end;
end;
dosau:=dem;
End;
{---------- BAC CUA NUT ---------}
Function BAC_NODE(n:node;T:Tree):integer;
Var i: integer;L:List;
Begin
L:=T.header[n];
if empty_L(L) then Bac_Node:=0
else
Bac_node:=L.Last;
End;
{---------- BAC CUA CAY ---------}
Function BAC_TREE(T:Tree):integer;
Var bac:integer;i:node;
Begin
bac:=Bac_Node(Root(T),T);
For i:=1 to T.Root do
if bac<bac_node(i,T) then
bac:=bac_node(i,T);
BAC_TREE:=bac;
End;
{------------ CHIEU CAO CUA CAY ---------}
Function Max(a,b:node):node;
Begin
if a>b then max:=a else max:=b;
End;
Function Height(n:node;T:Tree):integer;
Var L:List;i:node;kq:integer;
Begin
if empty_T(T) then kq:=0
else
begin
i:=leftmost_child(n,T);
while i0 do
begin
kq:=max(kq,height(i,T));
i:=right_sibling(i,T);
end;
end;
height:=kq;
End;
{------------ DUYET TIEN TU ---------}
Procedure PreOrder(n:node;T:Tree);
Var L:List;i:node;
Begin
write(Labell(n,T));
i:=leftmost_child(n,T);
while i0 do
begin
n:=i;
PreOrder(i,T);
i:=Right_sibling(n,T);
end;
end;
{------------ DUYET TRUNG TU ---------}
Procedure InOrder(n:node;T:Tree);
Var i:node;
Begin
i:=Leftmost_child(n,T);
if i0 then InOrder(i,T);
write(Labell(i,T));
while i0 do
begin
n:=i;
InOrder(i,T);
i:=Right_sibling(n,T);
end;
End;
{--------- DUYET HAU TU --------}
Procedure PostOrder(n:node;T:Tree);
Var i: node;
Begin
i:=Leftmost_child(n,T);
while i0 do
begin
PostOrder(i,T);
i:=right_sibling(n,T);
end;
write(labell(n,T));
End;
End;
VI- CÂY NHỊ PHÂN:
Uses CRT;
Type
LabelType=char;
Tree= ^node;
Node = Record
Left: Tree; { tro den con trai cua nut }
Right: Tree; { tro den con ben phai }
Labell: labeltype;
end;
Var T: Tree;
{---------- TAO CAY RONG-------- }
Procedure Makenull(Var T:Tree);
Begin
T:=nil;
End;
{----------- KIEM TRA CAY RONG --------}
Function Empty(T:Tree):boolean;
Begin
empty:=T=nil;
End;
{---------- CON TRAI CUA NUT ---------}
Function Left_child(T:Tree):Tree;
Begin
if not empty(T) then
Left_child:=T^.Left
else Left_child:=nil;
End;
{--------- CON PHAI CUA NUT ---------}
Function Right_child(T:Tree):Tree;
Begin
if not empty(T) then
right_child:=T^.right
else right_child:=nil;
End;
{------- KIEM TRA NUT LA ---------}
Function ISLEAT(T: Tree):Boolean;
Begin
if (Tnil) and (T^.leftnil) and (T^.rightnil) then
ISLEAT:=true
else ISLEAT:=False;
End;
{--------- TAO CAY MOI TU 2 CAY CO SAN ----------}
Function CREATE2(V:labeltype;T1:Tree;T2:Tree):Tree;
Var tam: Tree;
Begin
new(tam);
tam^.labell:=v;
tam^.Left:=T1;tam^.right:=T2;
Create2:=tam;
End;
{----------- THEM MOT NUT VAO BEN TRAI NHAT ---------}
Procedure Insert_Left(x: labeltype;Var T:Tree);
Var p,q: Tree;
Begin
new(p);p^.labell:=x;p^.left:=nil;P^.right:=nil;
if empty(T) then T:=p
else
begin
q:=T;
while q^.Leftnil do q:=q^.left;
Q^.Left:=p;
end;
End;
{----------- THEM MOT NUT VAO BEN PHAI ---------}
Procedure Insert_Right(x: labeltype;Var T:Tree);
Var p,q: Tree;
Begin
new(p);p^.labell:=x;p^.left:=nil;P^.right:=nil;
if empty(T) then T:=p
else
begin
q:=T;
while q^.rightnil do q:=q^.right;
Q^.Left:=p;
end;
End;
{---------- TAO NUT GOC -----------}
Procedure Nut_goc(x: labeltype;Var T:Tree);
Var tam: Tree;
Begin
new(tam);
tam^.labell:=x;
tam^.left:=nil;tam^.right:=nil;
if empty(T) then T:=tam;
End;
{--------- NHAP CAY NHI PHAN --------}
Procedure Read_Tree(Var T: Tree);
Var x: labeltype;T2: Tree; ch: char;
i:integer;
Begin
i:=1;
write('- Nhap nhan cua nut goc ');
readln(x); nut_goc(x,T);
writeln(' - Nhap cac con :');
Repeat
write(' Ban them con trai hay phai? (L/R/K):');
readln(ch);
if upcase(ch)'K' then
begin
write(' - Nhap nhan cua nut thu ',i,': ');
readln(x);
if upcase(ch)='L' then
insert_Left(x,T^.Left)
else
if upcase(ch)='R' then
insert_right(x,T^.Right);
i:=i+1;
end;
Until upcase(ch)='K'
End;
{--------- DUYET TIEN TU --------}
Procedure PreOrder(T:Tree);
Var P: Tree;
Begin
p:=t;
if Pnil then
begin
write(P^.labell:2); PreOrder(P^.Left); PreOrder(P^.Right);
end;End;
VII- CÂY TÌM KIẾM NHỊ PHÂN:
Uses CRT;
Type
KeyType=integer;
BSTree=^Node;
Node = Record
key: KeyType;
Left, Right: BSTree;
End;
Var T: BSTree; x: KeyType;dem:integer;
{---------- TAO CAY RONG ----------}
Procedure Makenull(Var T: BSTree);
Begin
T:=nil;
End;
{---------- KIEM TRA CAY RONG --------}
Function Empty(T: BSTree):boolean;
Begin
empty:=T=nil;
End;
{--------- CON TRAI CUA NUT -------}
Function Left_child(n:BSTree;T:BSTree):BSTree;
Begin
if empty(T) then Left_child:=nil
else Left_child:=T^.Left;
End;
{--------- CON PHAI CUA NUT -------}
Function Right_child(n:BSTree;T:BSTree):BSTree;
Begin
if empty(T) then Right_child:=nil
else Right_child:=T^.right;
End;
{---------- THEM NUT VAO CAY: DE QUI ----------}
Procedure Insert(x:keyType;Var T: BSTree);
Var P,tam:BSTree;
Begin
if T=nil then
begin
new(tam);tam^.key:=x;
tam^.left:=nil;tam^.right:=nil;
T:=tam;
end
else
begin
P:=T;
if P^.key=x then writeln(x,' da ton tai trong cay!')
else
if P^.key<x then insert(x,P^.right)
else
insert(x,P^.left);
end;
End;
{------------ THEM NUT SU DUNG PP KHONG DE QUI ---------}
Procedure Insert1(x:KeyType;Var T: BSTree);
Var P,Q,tam: BSTree;LR:integer;
Begin
new(tam);
tam^.left:=T;Q:=tam;LR:=-1;
P:=T;
while Pnil do
begin
Q:=P;
if P^.key>x then
begin P:=P^.left;LR:=-1;end
else begin P:=P^.right;LR:=1;end;
end;
if P=nil then
begin
new(P);
P^.key:=x; P^.left:=nil; P^.right:=nil;
if LR=-1 then
Q^.Left:=P
else
Q^.Right:=P;
end;
T:=tam^.left;
End;
{---------- DUYET TIEN TU ---------}
Procedure PreOrder(T:BSTree);
Var i:BSTree;
Begin
if Tnil then
begin
write(T^.key:3); PreOrder(T^.Left); PreOrder(T^.Right);
end;
End;
{---------- DUYET TRUNG TU --------}
Procedure InOrder(T:BSTree);
Var i:BSTree;
Begin
if Tnil then
begin
InOrder(T^.Left); write(T^.key:3); InOrder(T^.Right);
end;End;
{---------- DUYET HAU TU --------}
Procedure PostOrder(T:BSTree);
Var i:BSTree;
Begin
if Tnil then
begin
PostOrder(T^.Left); PostOrder(T^.Right); write(T^.key:3);
end;End;
{------- KIEM TRA NUT LA ---------}
Function ISLEAT(T: BSTree):Boolean;
Begin
if (Tnil) and (T^.leftnil) and (T^.rightnil) then
ISLEAT:=true
else ISLEAT:=False;
End;
{----------- DEM SO NUT LA -----------}
Procedure Number_La(T:BSTree;Var dem:integer);
Var k:integer;
Begin
k:=0;
if Tnil then
begin
if not isleat(T^.Left) then
number_la(T^.left,dem);
k:=k+1;
if not isleat(T^.right) then
number_la(T^.right,dem);
k:=k+1;
end;
dem:=k;End;
{------------ CHIEU CAO CUA CAY -------------}
Function Max(a,b:integer):integer;
Begin
if a>=b then max:=a else max:=b;
End;
Function ChieuCao(T:BSTree):integer;
Var h,a,b: integer; P:BSTree;
Begin
if not empty(T) then
begin
number_la(T^.left,a);
number_la(T^.right,b);
h:=max(a,b)+1;
end;
chieucao:=h; End;
{------------ tim nut co khoa x cho truoc ------------}
Function Local(x:KeyType;T:BSTree; dosau:integer):integer;
Var P:integer;
Begin
P:=T^.key;
if empty(T) then dosau:=-1
else
if P=x then Local:=dosau
else
if x>P then Local:=Local(x,T^.right,dosau+1)
else
if x<P then Local:=Local(x,T^.left,dosau+1)
End;
Các file đính kèm theo tài liệu này:
- Code các kiểu dữ liệu trừu tượng - Pascal.doc