首次学习链表，练习写了个二叉树排序。可惜老出现错误……

Question

type
link=^data;
data=record
num=longint;
left:link;
right:link;
end;

var
tree,head,tail_left,tail_right:link;
n:longint;

procedure start;
var
i,j,k,l:longint;
begin
head:=nil;
end;

procedure make(x:longint);
var
i,j,k,l:longint;
now:link;
begin
tree:=head^.next;
while tree=nil do
begin
if x>make^.num
then tree:=tree^.left
else tree:=tree^.right;
end;
new(tree);
tree^.zhi:=x;
end;

procedure init;
var
i,j,k,l:longint;
begin
start;
readln(n);
for i:=1 to n do
begin
read(zhi);
make(zhi);
end;
tree:=head^.next;
end;

procedure mid_bl(tree:link);
var
i,j,k,l:longint;
begin
if tree=nil then exit;
mid_bl(tree^.left);
write(tree^.num,' ');
mid_bl(tree^.right);
end;

begin
init;
mid(tree);
end.

Answer 1

你的make过程有点问题：循环里已经判断tree=nil了，还要tree^.num做什么？（此时的tree^.num是空值，不存在,自然判错。。..下面是我写的BINARYTREE:PROGRAM BinaryTree (input, output);TYPE element=char;Btree=^node;node=recorddata: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;beginif t=nil thenbegint:=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;begint:=nil;read(data);while data <> ENDTAG dobeginnew(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);beginif t <> nil thenbeginDestroyTree(t^.lc);DestroyTree(t^.rc);dispose(t);t := nil;end; {if}end; {DestroyTree}{递归算法:}{先序遍历}PROCEDURE Preorder_1(t : Btree);beginif t <> nil thenbeginwrite(t^.data:WIDTH); {输出该结点（根结点）}Preorder_1(t^.lc); {遍历左子树}Preorder_1(t^.rc); {遍历右子树}end;end;{中序遍历}PROCEDURE Inorder_1(t : Btree);beginif t <> nil thenbeginInorder_1(t^.lc); {遍历左子树}write(t^.data:WIDTH); {输出该结点（根结点）}Inorder_1(t^.rc); {遍历右子树}end;end;{后序遍历}PROCEDURE Postorder_1(t : Btree);beginif t <> nil thenbeginPostorder_1(t^.lc); {遍历左子树}Postorder_1(t^.rc); {遍历右子树}write(t^.data:WIDTH); {输出该结点（根结点）}end;end;{非递归算法（使用栈存储树）}{先序遍历}PROCEDURE Preorder_2(t : Btree);varp : Btree; {p表示当前结点}stack : array [1..MAX] of Btree; {栈stack[]用来存储结点}top : integer;begintop := 1;if t <> nil then {先判断是否为空树}beginstack[top] := t; {根结点入栈}while top >= 1 do {栈内还有元素}beginp := stack[top]; {栈顶元素出栈}dec(top);write(p^.data:WIDTH);if p^.rc <> nil then {如果该结点有右孩子，将右孩子入栈}begininc(top);stack[top] := p^.rc;end; {if}if p^.lc <> nil then{如果该结点有左孩子，将左孩子入栈，按照后入先出原则，左孩子先出栈}begininc(top);stack[top] := p^.lc;end; {if}end; {while}end;{if}end;{Preorder_2}{先序遍历}PROCEDURE Preorder_3(t : Btree);varp : Btree; {p表示当前结点}stack : array [1..MAX] of Btree; {栈stack[]用来存储结点}top : integer;begintop := 1;if t <> nil then {先判断是否为空树}beginp := t;while (p <> nil) or (top > 1) dobeginif p <> nil then {先一直寻找左孩子}beginstack[top] := p; {结点入栈}inc(top);write(p^.data:WIDTH);p := p^.lc;end {if}else {没有左孩子了，转而寻找右孩子}begindec(top);p := stack[top]; {栈顶元素出栈}p := p^.rc;end; {if}end; {while}end;{if}end;{Preorder_3}{中序遍历}PROCEDURE Inorder_2(t : Btree);varp : Btree; {p表示当前结点}stack : array [1..MAX] of Btree; {栈stack[]用来存储结点}top : integer;begintop := 1;if t <> nil then {先判断是否为空树}beginp := t;while top >= 1 dobeginif p <> nil then {先一直寻找左孩子}beginstack[top] := p; {结点入栈}inc(top);p := p^.lc;end {if}else if top > 1 then{没有左孩子了，转而寻找栈顶元素的右孩子}begindec(top);p := stack[top]; {栈顶元素出栈}write(p^.data:WIDTH);p := p^.rc;end {if}elsetop := 0; {栈内无元素，跳出循环}end; {while}end;{if}end; {Inorder_2}{中序遍历}PROCEDURE Inorder_3(t : Btree);varp : Btree; {p表示当前结点}stack : array [1..MAX] of Btree; {栈stack[]用来存储结点}top : integer;begintop := 0;p := t;repeatwhile p <> nil do {先一直寻找左孩子}begininc(top);stack[top] := p; {结点入栈}p := p^.lc;end; {while}if top >= 1 then {所有左孩子处理完毕后，寻找栈顶元素的右孩子}beginp := 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);varp : Btree; {p表示当前结点}stack : array [1..MAX] of Btree; {栈stack[]用来存储结点}tag : array[1..MAX] of integer;{用来存储该结点的左右孩子是否都被访问过的信息}top : integer;begintop := 0;p := t;repeatwhile p <> nil do {先一直寻找左孩子}begininc(top);stack[top] := p; {结点入栈}p := p^.lc;tag[top] := 0; {表示右孩子没有被访问}end; {while}if top >= 1 then {所有左孩子处理完毕后}beginif tag[top] = 0 then {如果右孩子没有被访问}beginp := stack[top]; {读取栈顶元素，但不退栈 ，因为要先输出其孩子结点}p := p^.rc;tag[top] := 1; {表示右孩子被访问，下次轮到该结点退栈时可直接输出}end {if}else {栈顶元素出栈，输出该结点，此时结点p指向NIL}beginwrite(stack[top]^.data:WIDTH);dec(top);end; {else}end; {if}until (p = nil) and (top < 1);end; {Postorder_2}{层序遍历使用一个先进先出的循环队列作为辅助手段}PROCEDURE LevelWays(t : Btree);varp : Btree; {p表示当前结点}queue : array [0..MAX] of Btree; {循环队列queue[]用来存储结点}front, rear : integer;beginfront := -1;rear := -1;if t <> nil then {先判断是否为空树}beginrear := 0;queue[rear] := t; {入队}end; {if}while front <> rear do {队列非空}beginfront := (front + 1) mod MAX;{出队列，并输出结点}p := queue[front];write(p^.data:WIDTH);if p^.lc <> nil then {左孩子非空则入列}beginrear := (rear + 1) mod MAX;queue[rear] := p^.lc;end; {if}if p^.rc <> nil then {右孩子非空则入列}beginrear := (rear + 1) mod MAX;queue[rear] := p^.rc;end; {if}end; {while}end; {LevelWays}{层序遍历：可以输出层号使用循环队列记录结点的层次，设levelUp为上次打印结点层号，level为本层打印结点层号}PROCEDURE LevelPrint(t : Btree);typelevelNode = recordlevel : integer;pointer : Btree;end;varp : Btree; {p表示当前结点}queue : array [0..MAX] of levelNode; {循环队列queue[]用来存储levelNode结点}front, rear, levelUp, level : integer;beginfront := -1;rear := -1;levelUp := 0;if t <> nil then {先判断是否为空树}beginrear := 0;queue[rear].level := 1; {结点层号入队}queue[rear].pointer := t; {结点内容入队}end; {if}while front <> rear do {队列非空}beginfront := (front + 1) mod MAX;{出队列，并输出结点}level := queue[front].level; {记录当前结点的层号}p := queue[front].pointer; {记录当前结点的内容}if level = levelUp then {和上次输出的结点在同一层，只输出结点}write(p^.data:WIDTH)else {和上次输出的结点不在同一层，换行后输出结点并修改levelUp的值}beginwriteln;write(p^.data:WIDTH);levelUp := level;end; {else}if p^.lc <> nil then {左孩子非空则入列}beginrear := (rear + 1) mod MAX;queue[rear].level := level + 1; {左孩子层号入列}queue[rear].pointer := p^.lc; {左孩子结点入列}end; {if}if p^.rc <> nil then {右孩子非空则入列}beginrear := (rear + 1) mod MAX;queue[rear].level := level + 1; {右孩子层号入列}queue[rear].pointer := p^.rc; {右孩子结点入列}end; {if}end; {while}end; {LevelPrint}{输出二杈树给定一个二杈树，输出其嵌套括号表示。采用的算法是：首先输出根结点，然后再依次输出它的左子树和右子树，不过在输出左子树之前要打印左括号，在输出右子树之前后要打印右括号；另外，依次输出左，右子树要至少有一个不为空，若都为空则不输出。因此，输出二杈树的递归函数如下：}PROCEDURE PrintBTree(t : Btree);beginif t <> nil thenbeginwrite(t^.data:WIDTH); {输出该结点（根结点）}if (t^.lc <> nil) or (t^.rc <> nil) thenbeginwrite('(');PrintBTree(t^.lc);if t^.rc <> nil thenwrite(',');PrintBTree(t^.rc);write(')');end; {if}end; {if}end; {PrintBTree}{求二杈树的深度：先序遍历二叉树的深度为二叉树中结点层次的最大值，即结点的层次自根结点起递推。设根结点为第一层的结点，所有h层的结点的左右孩子在h+1层。可以通过先序遍历计算二叉树中每个结点的层次，其中最大值即为二叉树的深度}PROCEDURE TreeDepth_1(t : Btree; h : integer; var depth : integer);beginif t <> nil thenbeginif h > depth thendepth := 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 = NULLdepth(b) = max(depth(b->lchild),depth(b->rchild)+1 其他因此，求二杈树的深度的递归函数如下：}FUNCTION TreeDepth_2(t : Btree): integer;vardep1, dep2 : integer;beginif t = nil thenTreeDepth_2 := 0elsebegindep1 := TreeDepth_2(t^.lc);dep2 := TreeDepth_2(t^.rc);if dep1 > dep2 thenTreeDepth_2 := dep1 + 1elseTreeDepth_2 := dep2 + 1;end; {else}end;{TreeDepth_2}{一般二叉树寻找方法：寻找元素值为data的结点，返回该结点}FUNCTION FindData(t : Btree; data : element):Btree;varp : Btree;beginif t = nil then {树为空，返回空}FindData := nilelsebeginif t^.data = data then {返回根结点}FindData := telsebeginp := FindData(t^.lc, data); {在左孩子中寻找}if p <> nil then {在左孩子中找到了}FindData := pelseFindData := FindData(t^.rc, data);{在右孩子中寻找}end;end;end; {FindData}{二杈排序树的查找：在二杈排序树b中查找x的过程为：1。若b是空树，则搜索失败，否则2。若x等于b的根结点的数据域之值，则查找成功；否则3。若x小于b的根结点的数据域之值，则搜索左子树；否则&nbsp;&nbsp;4。搜索右子树}FUNCTION Search(t : Btree; data : element):Btree;beginif t = nil then {树为空，返回空}Search := nilelsebeginif t^.data = data then {返回根结点}Search := telse if t^.data > data thenSearch := Search(t^.lc, data) {在左孩子中寻找}elseSearch := 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;begintop:=0;p:=t;repeatwhile p<>nil do {先一直寻找左孩子}begininc(top);stack[top] := p; {结点入栈}p := p^.lc;tag[top] := 0; {表示右孩子没有被访问}end; {while}if top>=1 then {所有左孩子处理完毕后}beginif tag[top]=0 then {如果右孩子没有被访问}beginp := stack[top]; {读取栈顶元素，但不退栈 ，因为要先输出其孩子结点}p := p^.rc;tag[top] := 1; {表示右孩子被访问，下次轮到该结点退栈时可直接输出}end {if}else {如果该结点的左右孩子都被访问过了}beginif stack[top]=obj then {找到目标结点，输出路径}beginwrite('The path: ');for i:=1 to top dowrite(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);beginif t<>nil thenbeginif 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;beginif p^.lc<>nil thenbeginr:=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;beginif p^.lc<>nil thenbeginr:=p^.lc;{r指向其左子树}q:=p^.lc;{q指向其左子树}while r^.rc<>nil do {搜索左子树的最右边的叶子结点r，q作为r的父亲}beginq:=r;r:=r^.rc;end;if q<>r then{若r不是p的左孩子，即p^.lc有右孩子}beginq^.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;beginif p^.lc<>nil thenbeginr:=p^.lc; {r指向其左子树}q:=p^.lc; {q指向其左子树}while r^.rc<>nil do {搜索左子树的最右边的叶子结点r，q作为r的父亲}beginq:=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}elsebeginr:=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.