typelink=^data;data=recordnum=longint;left:link;right:link;end;vartree,head,tail_left,tail_right:link;n:longint;procedure start;vari,j,k,l:longint;beginhead:=nil;end;procedure make(x:longint);vari,j,k,l:longint;now:link;begintree:=head^.next;while tree=nil dobeginif x>make^.numthen tree:=tree^.leftelse tree:=tree^.right;end;new(tree);tree^.zhi:=x;end;procedure init;vari,j,k,l:longint;beginstart;readln(n);for i:=1 to n dobeginread(zhi);make(zhi);end;tree:=head^.next;end;procedure mid_bl(tree:link);vari,j,k,l:longint;beginif tree=nil then exit;mid_bl(tree^.left);write(tree^.num,' ');mid_bl(tree^.right);end;begininit;mid(tree);end.
1 回答
汪汪一只貓
TA貢獻1898條經驗 獲得超8個贊
你的make過程有點問題：循環里已經判斷tree=nil了，還要tree^.num做什么？（此時的tree^.num是空值，不存在,自然判錯。。..
下面是我寫的BINARYTREE:
PROGRAM BinaryTree (input, output);
TYPE element=char;
Btree=^node;
node=record
data:element;
lc,rc:Btree;
end;
CONST MAX=1000; {最大結點數量}
WIDTH=2; {輸出元素值寬度}
ENDTAG='#';
VAR root,obj:Btree;
height,depth:integer;
data : element;
{向一個二叉排序樹b中插入一個結點s}
FUNCTION InsertNode(var t : Btree; s : Btree) : boolean;
begin
if t=nil then
begin
t:=s;
InsertNode := true;
end {if}
else if t^.data > s^.data then {把s所指結點插入到左子樹中}
InsertNode := InsertNode(t^.lc, s)
else if t^.data < s^.data then {把s所指結點插入到右子樹中}
InsertNode := InsertNode(t^.rc, s)
else {若s->data等于b的根結點的數據域之值，則什么也不做}
InsertNode := false;
end; {InsertNode}
{生成一棵二叉排序樹（以ENDTAG為結束標志）}
PROCEDURE CreateTree(var t : Btree);
var data:element;
s:Btree;
begin
t:=nil;
read(data);
while data <> ENDTAG do
begin
new(s);
s^.data := data;
s^.lc := nil;
s^.rc := nil;
if not(InsertNode(t, s)) then dispose(s);{插入一個結點s}
read(data);
end;
end;
{銷毀一棵二叉排序樹}
PROCEDURE DestroyTree(var t : Btree);
begin
if t <> nil then
begin
DestroyTree(t^.lc);
DestroyTree(t^.rc);
dispose(t);
t := nil;
end; {if}
end; {DestroyTree}
{遞歸算法:}
{先序遍歷}
PROCEDURE Preorder_1(t : Btree);
begin
if t <> nil then
begin
write(t^.data:WIDTH); {輸出該結點（根結點）}
Preorder_1(t^.lc); {遍歷左子樹}
Preorder_1(t^.rc); {遍歷右子樹}
end;
end;
{中序遍歷}
PROCEDURE Inorder_1(t : Btree);
begin
if t <> nil then
begin
Inorder_1(t^.lc); {遍歷左子樹}
write(t^.data:WIDTH); {輸出該結點（根結點）}
Inorder_1(t^.rc); {遍歷右子樹}
end;
end;
{后序遍歷}
PROCEDURE Postorder_1(t : Btree);
begin
if t <> nil then
begin
Postorder_1(t^.lc); {遍歷左子樹}
Postorder_1(t^.rc); {遍歷右子樹}
write(t^.data:WIDTH); {輸出該結點（根結點）}
end;
end;
{非遞歸算法（使用棧存儲樹）}
{先序遍歷}
PROCEDURE Preorder_2(t : Btree);
var
p : Btree; {p表示當前結點}
stack : array [1..MAX] of Btree; {棧stack[]用來存儲結點}
top : integer;
begin
top := 1;
if t <> nil then {先判斷是否為空樹}
begin
stack[top] := t; {根結點入棧}
while top >= 1 do {棧內還有元素}
begin
p := stack[top]; {棧頂元素出棧}
dec(top);
write(p^.data:WIDTH);
if p^.rc <> nil then {如果該結點有右孩子，將右孩子入棧}
begin
inc(top);
stack[top] := p^.rc;
end; {if}
if p^.lc <> nil then{如果該結點有左孩子，將左孩子入棧，按照后入先出原則，左孩子先出棧}
begin
inc(top);
stack[top] := p^.lc;
end; {if}
end; {while}
end;{if}
end;{Preorder_2}
{先序遍歷}
PROCEDURE Preorder_3(t : Btree);
var
p : Btree; {p表示當前結點}
stack : array [1..MAX] of Btree; {棧stack[]用來存儲結點}
top : integer;
begin
top := 1;
if t <> nil then {先判斷是否為空樹}
begin
p := t;
while (p <> nil) or (top > 1) do
begin
if p <> nil then {先一直尋找左孩子}
begin
stack[top] := p; {結點入棧}
inc(top);
write(p^.data:WIDTH);
p := p^.lc;
end {if}
else {沒有左孩子了，轉而尋找右孩子}
begin
dec(top);
p := stack[top]; {棧頂元素出棧}
p := p^.rc;
end; {if}
end; {while}
end;{if}
end;{Preorder_3}
{中序遍歷}
PROCEDURE Inorder_2(t : Btree);
var
p : Btree; {p表示當前結點}
stack : array [1..MAX] of Btree; {棧stack[]用來存儲結點}
top : integer;
begin
top := 1;
if t <> nil then {先判斷是否為空樹}
begin
p := t;
while top >= 1 do
begin
if p <> nil then {先一直尋找左孩子}
begin
stack[top] := p; {結點入棧}
inc(top);
p := p^.lc;
end {if}
else if top > 1 then{沒有左孩子了，轉而尋找棧頂元素的右孩子}
begin
dec(top);
p := stack[top]; {棧頂元素出棧}
write(p^.data:WIDTH);
p := p^.rc;
end {if}
else
top := 0; {棧內無元素，跳出循環}
end; {while}
end;{if}
end; {Inorder_2}
{中序遍歷}
PROCEDURE Inorder_3(t : Btree);
var
p : Btree; {p表示當前結點}
stack : array [1..MAX] of Btree; {棧stack[]用來存儲結點}
top : integer;
begin
top := 0;
p := t;
repeat
while p <> nil do {先一直尋找左孩子}
begin
inc(top);
stack[top] := p; {結點入棧}
p := p^.lc;
end; {while}
if top >= 1 then {所有左孩子處理完畢后，尋找棧頂元素的右孩子}
begin
p := stack[top]; {棧頂元素出棧}
dec(top);
write(p^.data:WIDTH);
p := p^.rc;
end; {if}
until (p = nil) and (top < 1);
end; {Inorder_3}
{后序遍歷}
PROCEDURE Postorder_2(t : Btree);
var
p : Btree; {p表示當前結點}
stack : array [1..MAX] of Btree; {棧stack[]用來存儲結點}
tag : array[1..MAX] of integer;{用來存儲該結點的左右孩子是否都被訪問過的信息}
top : integer;
begin
top := 0;
p := t;
repeat
while p <> nil do {先一直尋找左孩子}
begin
inc(top);
stack[top] := p; {結點入棧}
p := p^.lc;
tag[top] := 0; {表示右孩子沒有被訪問}
end; {while}
if top >= 1 then {所有左孩子處理完畢后}
begin
if tag[top] = 0 then {如果右孩子沒有被訪問}
begin
p := stack[top]; {讀取棧頂元素，但不退棧 ，因為要先輸出其孩子結點}
p := p^.rc;
tag[top] := 1; {表示右孩子被訪問，下次輪到該結點退棧時可直接輸出}
end {if}
else {棧頂元素出棧，輸出該結點，此時結點p指向NIL}
begin
write(stack[top]^.data:WIDTH);
dec(top);
end; {else}
end; {if}
until (p = nil) and (top < 1);
end; {Postorder_2}
{層序遍歷
使用一個先進先出的循環隊列作為輔助手段
}
PROCEDURE LevelWays(t : Btree);
var
p : Btree; {p表示當前結點}
queue : array [0..MAX] of Btree; {循環隊列queue[]用來存儲結點}
front, rear : integer;
begin
front := -1;
rear := -1;
if t <> nil then {先判斷是否為空樹}
begin
rear := 0;
queue[rear] := t; {入隊}
end; {if}
while front <> rear do {隊列非空}
begin
front := (front + 1) mod MAX;{出隊列，并輸出結點}
p := queue[front];
write(p^.data:WIDTH);
if p^.lc <> nil then {左孩子非空則入列}
begin
rear := (rear + 1) mod MAX;
queue[rear] := p^.lc;
end; {if}
if p^.rc <> nil then {右孩子非空則入列}
begin
rear := (rear + 1) mod MAX;
queue[rear] := p^.rc;
end; {if}
end; {while}
end; {LevelWays}
{層序遍歷：可以輸出層號
使用循環隊列記錄結點的層次，設levelUp為上次打印結點層號，level為本層打印結點層號
}
PROCEDURE LevelPrint(t : Btree);
type
levelNode = record
level : integer;
pointer : Btree;
end;
var
p : Btree; {p表示當前結點}
queue : array [0..MAX] of levelNode; {循環隊列queue[]用來存儲levelNode結點}
front, rear, levelUp, level : integer;
begin
front := -1;
rear := -1;
levelUp := 0;
if t <> nil then {先判斷是否為空樹}
begin
rear := 0;
queue[rear].level := 1; {結點層號入隊}
queue[rear].pointer := t; {結點內容入隊}
end; {if}
while front <> rear do {隊列非空}
begin
front := (front + 1) mod MAX;{出隊列，并輸出結點}
level := queue[front].level; {記錄當前結點的層號}
p := queue[front].pointer; {記錄當前結點的內容}
if level = levelUp then {和上次輸出的結點在同一層，只輸出結點}
write(p^.data:WIDTH)
else {和上次輸出的結點不在同一層，換行后輸出結點并修改levelUp的值}
begin
writeln;
write(p^.data:WIDTH);
levelUp := level;
end; {else}
if p^.lc <> nil then {左孩子非空則入列}
begin
rear := (rear + 1) mod MAX;
queue[rear].level := level + 1; {左孩子層號入列}
queue[rear].pointer := p^.lc; {左孩子結點入列}
end; {if}
if p^.rc <> nil then {右孩子非空則入列}
begin
rear := (rear + 1) mod MAX;
queue[rear].level := level + 1; {右孩子層號入列}
queue[rear].pointer := p^.rc; {右孩子結點入列}
end; {if}
end; {while}
end; {LevelPrint}
{輸出二杈樹
給定一個二杈樹，輸出其嵌套括號表示。
采用的算法是：首先輸出根結點，然后再依次輸出它的左子樹和右子樹，不過在輸出左子樹
之前要打印左括號，在輸出右子樹之前后要打印右括號；另外，依次輸出左，右子樹要至少
有一個不為空，若都為空則不輸出。
因此，輸出二杈樹的遞歸函數如下：
}
PROCEDURE PrintBTree(t : Btree);
begin
if t <> nil then
begin
write(t^.data:WIDTH); {輸出該結點（根結點）}
if (t^.lc <> nil) or (t^.rc <> nil) then
begin
write('(');
PrintBTree(t^.lc);
if t^.rc <> nil then
write(',');
PrintBTree(t^.rc);
write(')');
end; {if}
end; {if}
end; {PrintBTree}
{求二杈樹的深度：先序遍歷
二叉樹的深度為二叉樹中結點層次的最大值，即結點的層次自根結點起遞推。
設根結點為第一層的結點，所有h層的結點的左右孩子在h+1層。
可以通過先序遍歷計算二叉樹中每個結點的層次，其中最大值即為二叉樹的深度}
PROCEDURE TreeDepth_1(t : Btree; h : integer; var depth : integer);
begin
if t <> nil then
begin
if h > depth then
depth := h;
TreeDepth_1(t^.lc, h+1, depth);
TreeDepth_1(t^.rc, h+1, depth);
end; {if}
end;{TreeDepth_1}
{求二杈樹的深度：后序遍歷
若一棵二杈樹為空，則其深度為0，否則其深度等于左字樹和右子樹中最大深度加1，即有如下
遞歸模型：
depth(b) = 0 若 b = NULL
depth(b) = max(depth(b->lchild),depth(b->rchild)+1 其他
因此，求二杈樹的深度的遞歸函數如下：}
FUNCTION TreeDepth_2(t : Btree): integer;
var
dep1, dep2 : integer;
begin
if t = nil then
TreeDepth_2 := 0
else
begin
dep1 := TreeDepth_2(t^.lc);
dep2 := TreeDepth_2(t^.rc);
if dep1 > dep2 then
TreeDepth_2 := dep1 + 1
else
TreeDepth_2 := dep2 + 1;
end; {else}
end;{TreeDepth_2}
{
一般二叉樹尋找方法：尋找元素值為data的結點，返回該結點
}
FUNCTION FindData(t : Btree; data : element):Btree;
var
p : Btree;
begin
if t = nil then {樹為空，返回空}
FindData := nil
else
begin
if t^.data = data then {返回根結點}
FindData := t
else
begin
p := FindData(t^.lc, data); {在左孩子中尋找}
if p <> nil then {在左孩子中找到了}
FindData := p
else
FindData := FindData(t^.rc, data);{在右孩子中尋找}
end;
end;
end; {FindData}
{二杈排序樹的查找：
在二杈排序樹b中查找x的過程為：
1。若b是空樹，則搜索失敗，否則
2。若x等于b的根結點的數據域之值，則查找成功；否則
3。若x小于b的根結點的數據域之值，則搜索左子樹；否則
4。搜索右子樹
}
FUNCTION Search(t : Btree; data : element):Btree;
begin
if t = nil then {樹為空，返回空}
Search := nil
else
begin
if t^.data = data then {返回根結點}
Search := t
else if t^.data > data then
Search := Search(t^.lc, data) {在左孩子中尋找}
else
Search := Search(t^.rc, data);{在右孩子中尋找}
end; {else}
end; {Search}
{應用：假設二杈數采用鏈接存儲結構進行存儲，root指向根結點，p所只結點為任一的結點，
編寫一個求出從根結點到p所指結點之間路徑的函數。
算法思路：本題采用非遞歸后序遍歷樹root，當后序遍歷訪問到p所指結點時，此時stack[]
所有元素均為p所指結點的祖先，由這些祖先便構成了一條從根結點到p所指結點的路徑。
}
PROCEDURE TreePath(t, obj : Btree);
var p:Btree; {p表示當前結點}
stack:array [1..MAX] of Btree; {棧stack[]用來存儲結點}
tag:array[1..MAX] of integer;{用來存儲該結點的左右孩子是否都被訪問過的信息}
top, i : integer;
begin
top:=0;
p:=t;
repeat
while p<>nil do {先一直尋找左孩子}
begin
inc(top);
stack[top] := p; {結點入棧}
p := p^.lc;
tag[top] := 0; {表示右孩子沒有被訪問}
end; {while}
if top>=1 then {所有左孩子處理完畢后}
begin
if tag[top]=0 then {如果右孩子沒有被訪問}
begin
p := stack[top]; {讀取棧頂元素，但不退棧 ，因為要先輸出其孩子結點}
p := p^.rc;
tag[top] := 1; {表示右孩子被訪問，下次輪到該結點退棧時可直接輸出}
end {if}
else {如果該結點的左右孩子都被訪問過了}
begin
if stack[top]=obj then {找到目標結點，輸出路徑}
begin
write('The path: ');
for i:=1 to top do
write(stack[i]^.data:WIDTH);
writeln;
top := 0; {跳出循環}
end {if}
else dec(top); {退棧}
end; {else}
end; {if}
until (p = nil) and (top < 1);
end; {TreePath}
{二叉排序樹的刪除：
對于一般的二叉樹來說，刪去樹中的一個結點是沒有意義的，因為它將使以被刪除的結點為根的子樹
變成森林，破壞了整棵樹的結構， 但是，對于二叉排序樹，刪去樹上的一個結點相當于刪去有序序列中的
一個記錄，只要在刪除某個結點后不改變二叉排序樹的特性即可。
在二叉排序樹上刪除一個結點的算法如下：
}
FUNCTION DelNode_1(p : Btree) : Btree; forward;
FUNCTION DelNode_2(p : Btree) : Btree; forward;
FUNCTION DelNode_3(p : Btree) : Btree; forward;
PROCEDURE DeleteData(var t : Btree; data : element);
begin
if t<>nil then
begin
if t^.data=data then t:=DelNode_3(t)
else if t^.data>data then DeleteData(t^.lc, data)
else DeleteData(t^.rc, data);
end; {else}
end; {DeleteData}
{其中刪除過程有兩種方法。
第一種過程如下：
1。若p有左子樹，用p的左孩子取代它；找到其左子樹的最右邊的葉子結點r，把p的右子樹作為r
的右子樹。
2。若p沒有左子樹，直接用p的右孩子取代它。
第二種過程如下：
1。若p有左子樹，找到其左子樹的最右邊的葉子結點r，用該葉子結點r來替代p，把r的左孩子
作為r的父親的右孩子。
2。若p沒有左子樹，直接用p的右孩子取代它。
兩種方法各有優劣，第一種操作簡單一點點，但均衡性不如第二種，因為它將結點p的右子樹
全部移到左邊來了。下面將分別以兩種種思路編寫代碼。
}
{第一種：}
FUNCTION DelNode_1(p:Btree):Btree;
var r,q:Btree;
begin
if p^.lc<>nil then
begin
r:=p^.lc; {r指向其左子樹}
while r^.rc<>nil do {搜索左子樹的最右邊的葉子結點r}
r := r^.rc;
r^.rc:=p^.rc; {把p的右子樹作為r的右子樹}
q:=p^.lc; {用p的左孩子取代它}
end {if}
else q:=p^.rc; {用p的右孩子取代它}
dispose(p);
DelNode_1:=q;
end;{DelNode_1}
{第二種：}
FUNCTION DelNode_2(p:Btree) : Btree;
var r,q:Btree;
begin
if p^.lc<>nil then
begin
r:=p^.lc;{r指向其左子樹}
q:=p^.lc;{q指向其左子樹}
while r^.rc<>nil do {搜索左子樹的最右邊的葉子結點r，q作為r的父親}
begin
q:=r;
r:=r^.rc;
end;
if q<>r then{若r不是p的左孩子，即p^.lc有右孩子}
begin
q^.rc:=r^.lc;{把r的左孩子作為r的父親的右孩子}
r^.lc:=p^.lc; {用葉子結點r來替代p}
end;{if}
r^.rc := p^.rc; {被刪結點p的右子樹作為r的右子樹}
end {if}
else r:=p^.rc;{用p的右孩子取代它}
dispose(p);
DelNode_2:=r;
end; {DelNode_2}
{但是上面這種方法，把r移來移去，很容易出錯，其實在這里我們刪除的只是p的元素值，
而不是它的地址，所以完全沒有必要移動指針。仔細觀察，發現我們刪除的地址實際上是
p的左子樹的最右邊的葉子結點r的地址，所以我們只要把r的數據填到p中，然后把r刪除即可。
算法如下：
}
FUNCTION DelNode_3(p:Btree):Btree;
var r,q:Btree;
begin
if p^.lc<>nil then
begin
r:=p^.lc; {r指向其左子樹}
q:=p^.lc; {q指向其左子樹}
while r^.rc<>nil do {搜索左子樹的最右邊的葉子結點r，q作為r的父親}
begin
q:=r;
r:=r^.rc;
end;
p^.data:=r^.data; {本算法關鍵：用r的值取代p的值}
if q<>r then {若r不是p的左孩子，即p^.lc有右孩子}
q^.rc:=r^.lc{把r的左孩子作為r的父親的右孩子}
else {否則直接刪除r結點}
p^.lc:=r^.lc;
end {if}
else
begin
r:=p;
p:=p^.rc;{用p的右孩子取代它}
end; {else}
dispose(r);{刪除r結點}
DelNode_3 := p;
end;{DelNode_3}
BEGIN {main}
write('Create Tree:');
CreateTree(root);writeln;
write('Print Tree Preorder:');
Preorder_1(root);writeln;
Preorder_2(root);writeln;
Preorder_3(root);writeln;
write('Print Tree Inorder:');
Inorder_1(root);writeln;
Inorder_2(root);writeln;
Inorder_3(root);writeln;
write('Print Tree Postorder:');
Postorder_1(root);writeln;
Postorder_2(root);writeln;
PrintBTree(root);writeln;
height:=1;
depth:=0;
TreeDepth_1(root,height,depth);
writeln('Height: ',depth:3);
depth:=TreeDepth_2(root);
writeln('Height: ',depth:3);
data:='a';
obj:=FindData(root,data);
if obj<>nil then TreePath(root, obj);
writeln;
obj:=Search(root, data);
if obj <> nil then TreePath(root, obj);
writeln;
LevelWays(root);writeln;
LevelPrint(root);writeln;READLN;
write('input delete data:');
read(data);
DeleteData(root, data);writeln;
LevelPrint(root);writeln;
writeln('DestroyTree : ');
DestroyTree(root);
if root<>nil then LevelPrint(root)
else writeln('DestroyTree!');
writeln;READLN;READLN;
END.
- 1 回答
- 0 關注
- 217 瀏覽
添加回答
舉報
0/150
提交
取消