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

Question

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.

Answer 1

你的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.