Name: PASCAL语言实现线索二叉树
Copyright: 始发于goal00001111的专栏；允许自由转载，但必须注明作者和出处
Author: goal00001111
Date: 07-12-08 09:25
Description:
本文讨论了如何将一个普通排序二叉树中序线索化的过程：先生成一棵排序二叉树，再将其中序线索化。
提供了中序遍历线索二叉树的非递归算法和对线索二叉树进行查找，删除和插入的算法。
并原创了直接创建线索二叉树和销毁线索二叉树的算法。
*/}
{线索二杈树
从上节的讨论得知：遍历二叉树是以一定规则将二叉树中结点排列成一个线性序列，得到二叉树中
结点的先序序列或中序序列或后序序列。这实际上是对一个非线性结构进行线性化操作，使每个结点（除
第一个和最后一个外）在这些线性序列中有且仅有一个直接前驱和直接后继。但是，当以二叉链表作为存储
结构时，只能找到结点的左，右孩子的信息，而不能直接得到结点在任一序列中的前驱和后继信息，这种
信息只能在遍历的动态过程中才能得到。
因为在有n个结点的二杈链表中必定存在n+1个空链域，故可以利用这些空链域来存放结点的前驱和
后继信息。
试做如下规定：若结点有左子树，则其lchild域指示其左孩子，否则令lchild域指示其前驱；
若结点有右子树，则其rchild域指示其右孩子，否则令rchild域指示其后继。为了避免混淆，需要改变
结点结构，增加两个标志域：LTag，RTag。
其中：LTag = 0，lchild域指示其左孩子； LTag = 1，lchild域指示其前驱。
RTag = 0，rchild域指示其右孩子； RTag = 1，rchild域指示其后继。
以这种结点结构构成的二叉链表作为二叉树的存储结构，叫做线索链表，其中指向结点前驱和后继
的指针，叫做线索。加上线索的二叉树叫做线索二叉树。对二叉树以某种次序遍历使其变成线索二叉树
的过程叫做线索化。
在线索树上进行遍历，只要先找到序列中的第一个结点，然后依次找结点后继直到其后继为空为止。
求遍历后的线性序列的前驱和后继。前序线索化能依次找到后继，但是前驱需要求双亲；
中序线索化前驱和后继都不需要求双亲，但是都不很直接；后序线索化能依次找到前驱，
但是后继需要求双亲。可以看出，线索化成中序是最佳的选择，基本上算是达到了要求。
有了线索二杈树，在写遍历线索二叉树的非递归算法时，不再需要构造一个栈，而是直接一个循环搞定。
}
{二叉树的二叉线索存储表示}
PROGRAM BThreadTree (input, output);
TYPE
element = char;
PointerTag = (Link, Thread); {Link:指针,Thread:线索}
BThrTree = ^node;
node = record
data : element;
lTag, rTag : PointerTag; {左，右孩子指针标志}
lc, rc : BThrTree;
end; {record}
CONST
MAX = 1000;
WIDTH = 2; {输出元素值宽度}
ENDTAG = '#';
VAR
root, obj : BThrTree;
data : element;
{为了方便起见，我们仿照线性表的存储结构，在二杈树的线索链表上也添加一个头结点，并令其lchild
域的指针指向二杈树的根结点，其rchild域的指针指向中序遍历时访问的最后一个结点；反之，令二杈树
中序序列的第一个结点的lchild域的指针和最后一个结点的rchild域的指针均指向头结点。
这好比为二杈树建立了一个双向线索链表，既可以从第一个结点起顺后继进行遍历，
也可以从最后一个结点起顺前驱进行遍历。
}
{中序遍历线索二杈树的非递归算法, head指向头结点}
PROCEDURE InorderBThr(head : BThrTree);
var
p : BThrTree; {p表示当前结点}
begin
p := head^.lc; {p指向根结点}
while p <> head do {空树或遍历结束时，p = head}
begin
while p^.lTag = Link do {寻找最左边的左孩子}
p := p^.lc;
write(p^.data:WIDTH); {输出该结点}
while (p^.rTag = Thread) and (p^.rc <> head) do {访问后继结点，直到后继为空}
begin
p := p^.rc;
write(p^.data:WIDTH); {输出后继结点}
end; {while}
p := p^.rc; {指向其右孩子，非后继结点}
end; {while}
end; {InorderBThr}
{中序线索化，pre是p的前驱结点}
PROCEDURE InThreading(var p, pre : BThrTree);
begin
if p <> nil then
begin
InThreading(p^.lc, pre); {左子树线索化}
if p^.lc = nil then {若当前结点的左子树为空，则建立前驱线索}
begin
p^.lTag := Thread;
p^.lc := pre;
end {if}
else
p^.lTag := Link;
{若前驱结点非空，且其右孩子为空，则建立后继线索}
if (pre <> nil) and (pre^.rc = nil) then
begin
pre^.rTag := Thread;
pre^.rc := p;
end; {if}
pre := p; {中序向前遍历接点 ，保持pre指向p的前驱}
pre^.rTag := Link; {默认前驱结点右孩子非空}
InThreading(p^.rc, pre); {右子树线索化}
end; {if}
end; {InThreading}
{中序遍历二杈树，并将其中序线索化}
FUNCTION InOrderThreading(t : BThrTree): BThrTree;
var
pre, head : BThrTree;
begin
new(head); {建立头结点}
head^.data := ENDTAG;
head^.lTag := Link;
head^.rTag := Thread;
head^.rc := head; {右指针回指，构成一个循环链表}
if t = nil then
head^.lc := head {若二杈树为空，则左指针回指}
else
begin
head^.lc := t;
pre := head;
InThreading(t, pre); {中序线索化}
pre^.rTag := Thread;
pre^.rc := head; {最后一个结点线索化}
head^.rc := pre; {此时pre指向最后一个结点}
end; {else}
InOrderThreading := head;
end; {InOrderThreading}
{应用示例：我先生成一棵二杈排序树（输入单个字符，以#结束），并以递归方式遍历输出结点；
然后把该二杈排序树中序线索化，最后中序遍历线索二杈树输出结点。
}
{向一个二叉排序树t中插入一个结点s；除了数据类型不同外，算法与普通的二叉排序树完全一样}
FUNCTION InsertNode(var t : BThrTree; s : BThrTree) : 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 : BThrTree);
var
data : element;
s : BThrTree;
begin
t := nil;
read(data);
while data <> ENDTAG do
begin
new(s);
s^.data := data;
s^.lc := nil;
s^.rc := nil;
s^.lTag := Link;
s^.rTag := Link;
if not(InsertNode(t, s)) then {插入一个结点s}
dispose(s);
read(data);
end; {while}
end; {CreateTree}
{中序遍历}
PROCEDURE Inorder(t : BThrTree);
begin
if t <> nil then
begin
Inorder(t^.lc); {遍历左子树}
write(t^.data:WIDTH); {输出该结点（根结点）}
Inorder(t^.rc); {遍历右子树}
end;
end; {Inorder}
{已知 p 结点，找出它的前驱结点}
FUNCTION PreNode(p : BThrTree): BThrTree;
begin
if p^.lTag = Thread then {直接找到前驱结点}
PreNode := p^.lc
else
begin
p := p^.lc;
while p^.rTag <> Thread do {在p的左子树，找最右尾结点}
p := p^.rc;
PreNode := p;
end; {else}
end; {PreNode}
{已知 p 结点，找出它的后继结点}
FUNCTION NextNode(p : BThrTree): BThrTree;
begin
if p^.rTag = Thread then {直接找到后继结点}
NextNode := p^.rc
else
begin
p := p^.rc;
while p^.lTag <> Thread do {在p的右子树，找最左尾结点}
p := p^.lc;
NextNode := p;
end; {else}
end; {NextNode}
{层序遍历：可以输出层次感, head指向头结点
使用循环队列记录结点的层次，设levelUp为上次打印结点层号，level为本层打印结点层号
}
PROCEDURE LevelPrint(head : BThrTree);
type
levelNode = record
level : integer;
pointer : BThrTree;
end;
var
p : BThrTree; {p表示当前结点}
queue : array [0..MAX] of levelNode; {循环队列queue[]用来存储levelNode结点}
front, rear, levelUp, level : integer;
begin
front := -1;
rear := -1;
levelUp := 0;
p := head^.lc; {p指向根结点}
if p <> head then {先判断是否为空树，空树时，p = head}
begin
rear := 0;
queue[rear].level := 1; {结点层号入队}
queue[rear].pointer := p; {结点内容入队}
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^.lTag = Link then {左孩子非空则入列}
begin
rear := (rear + 1) mod MAX;
queue[rear].level := level + 1; {左孩子层号入列}
queue[rear].pointer := p^.lc; {左孩子结点入列}
end; {if}
if p^.rTag = Link then {右孩子非空则入列}
begin
rear := (rear + 1) mod MAX;
queue[rear].level := level + 1; {右孩子层号入列}
queue[rear].pointer := p^.rc; {右孩子结点入列}
end; {if}
end; {while}
end; {LevelPrint}
{查找值为data的结点的递归算法}
FUNCTION Search(p: BThrTree; data : element):BThrTree;
begin
if p^.lc = p then {空树}
Search := nil
else if p^.data = data then {返回根结点}
Search := p
else if (p^.data > data) then
begin
if p^.lTag = Link then {有左孩子}
Search := Search(p^.lc, data) {在左孩子中寻找}
else {没有左孩子，说明没找到data}
Search := nil;
end {else if}
else
begin
if p^.rTag = Link then {有右孩子}
Search := Search(p^.rc, data){在右孩子中寻找}
else {没有右孩子，说明没找到data}
Search := nil;
end; {else}
end; {Search}
{删除线索二杈树结点p}
PROCEDURE DelNode(var p : BThrTree);
var
pre, next : BThrTree;
begin
pre := PreNode(p);
next := NextNode(p);
if (p^.lTag = Thread) and (p^.rTag = Thread) then {p是叶子结点}
if p = next^.lc then {p是左孩子}
begin {此处必须先删除结点p，否则出错，不知为何;而且pre=头结点时，p=pre，何故？}
dispose(p); {删除结点p}
next^.lTag := Thread; {修改p的后继结点，即其双亲}
next^.lc := pre;
if pre^.rTag = Thread then {如果pre没有右孩子}
pre^.rc := next;
end {if}
else {p是右孩子，只需修改p的前驱结点，不需要修改后继}
begin
dispose(p); {删除结点p}
pre^.rTag := Thread;
pre^.rc := next;
end {else}
else {p不是叶子结点}
begin
if p^.lTag = Link then {p有左孩子}
begin
p^.data := pre^.data; {复制前驱结点的值，并删除前驱结点}
DelNode(pre); {删除其左子树的结点}
end {if}
else {p没有左孩子，即只有右孩子}
begin
p^.data := next^.data; {复制后继结点的值，并删除后继结点}
DelNode(next); {删除右子树的结点}
end; {else}
end; {else}
end; {DelNode}
{删除线索二叉树中值域为data的结点的递归算法}
PROCEDURE DeleteData(var p : BThrTree; data : element);
begin
if p^.lc = p then {空树，什么也不做}
else if p^.data = data then
DelNode(p)
else if (p^.data > data) and (p^.lTag = Link) then
DeleteData(p^.lc, data)
else if (p^.data < data) and (p^.rTag = Link) then
DeleteData(p^.rc, data)
end; {DeleteData}
{销毁一棵线索二叉树}
PROCEDURE DestroyTree(var head : BThrTree);
begin
while head^.lc <> head do
begin
DelNode(head^.lc); writeln;LevelPrint(root);writeln;
end; {while}
dispose(head);
head := nil;
end; {DestroyTree}
{向一棵线索二杈树t中插入一个结点s的递归算法}
FUNCTION InsertBThrNode(var p : BThrTree; s : BThrTree) : boolean;
begin
if p^.data > s^.data then {把s所指结点插入到左子树中}
begin
if p^.lTag = Link then {有左孩子}
InsertBThrNode := InsertBThrNode(p^.lc, s)
else {无左孩子，直接插入s}
begin
s^.lc := p^.lc; {p^.lc即前驱}
s^.rc := p; {设置s的后继}
if p^.lc^.rTag = Thread then {修改t的前驱的后继}
p^.lc^.rc := s;
p^.lTag := Link;{p有了左孩子}
p^.lc := s;
InsertBThrNode := true;
end; {else}
end {else if}
else if p^.data < s^.data then {把s所指结点插入到右子树中}
begin
if p^.rTag = Link then {有右孩子}
InsertBThrNode := InsertBThrNode(p^.rc, s)
else {无右孩子，直接插入s}
begin
s^.lc := p; {设置s的前驱}
s^.rc := p^.rc; {设置s的后继}
p^.rTag := Link;{p有了右孩子}
p^.rc := s;
InsertBThrNode := true;
end; {else}
end {else if}
else {若s->data等于p结点的数据域之值，则什么也不做}
InsertBThrNode := false;
end; {InsertBThrNode}
{生成一棵线索二杈树, head指向头结点}
PROCEDURE CreateBThrTree(var head : BThrTree);
var
s : BThrTree;
data : element;
begin
new(head); {建立头结点}
head^.data := ENDTAG;
head^.lTag := Link;
head^.rTag := Thread;
head^.rc := head; {右指针回指，构成一个循环链表}
head^.lc := head; {左指针回指，构成一个循环链表}
read(data);
if data <> ENDTAG then {创建根结点}
begin
new(s);
s^.data := data;
s^.lTag := Thread;
s^.rTag := Thread;
s^.lc := head;
s^.rc := head;
head^.lc := s;
head^.rc := s;
read(data);
while data <> ENDTAG do {插入一个结点s}
begin
new(s);
s^.data := data;
s^.lc := nil;
s^.rc := nil;
s^.lTag := Thread;
s^.rTag := Thread;
if not(InsertBThrNode(head^.lc, s)) then {插入一个结点s}
dispose(s);
read(data);
end;
end; {if}
end; {CreateBThrTree}
BEGIN {main}
root := nil;
write('Create Tree:');
CreateTree(root); {生成一棵二杈排序树}
readln;
writeln;
Inorder(root); {中序遍历二杈排序树递归算法}
writeln;
root := InOrderThreading(root); {中序遍历二杈树，并将其中序线索化}
InorderBThr(root);{中序遍历线索二杈树的非递归算法}
writeln;
LevelPrint(root);
writeln;
writeln;
write('input Search data:');
read(data);
readln;
writeln('data = ', data);
obj := Search(root^.lc, data);
if obj <> nil then
begin
writeln('pre: ', PreNode(obj)^.data);
writeln('next: ', NextNode(obj)^.data);
end {if}
else
writeln('no');
write('input delete data:');
read(data);
while (root <> root^.lc) and (data <> ENDTAG) do
begin
DeleteData(root^.lc, data);
writeln;
LevelPrint(root);
writeln;
if root <> root^.lc then {不是空树}
begin
write('input delete data:');
readln;
read(data);
end
else
writeln('Is Empty!');
writeln;
end; {while}
readln;
writeln('DestroyTree : ');
DestroyTree(root);
if root <> nil then
InorderBThr(root){中序遍历线索二杈树的非递归算法}
else
writeln('DestroyTree!');
writeln;
write('Create Tree:');
CreateBThrTree(root); {生成一棵线索二杈树}
readln;
writeln;
LevelPrint(root);
writeln;
write('input Search data:');
read(data);
readln;
writeln('data = ', data);
obj := Search(root^.lc, data);
if obj <> nil then
begin
writeln('pre: ', PreNode(obj)^.data);
writeln('next: ', NextNode(obj)^.data);
end {if}
else
writeln('no');
write('input delete data:');
read(data);
while (root <> root^.lc) and (data <> ENDTAG) do
begin
DeleteData(root^.lc, data);
writeln;
LevelPrint(root);
writeln;
if root <> root^.lc then {不是空树}
begin
write('input delete data:');
readln;
read(data);
end
else
writeln('Is Empty!');
writeln;
end; {while}
readln;
writeln('DestroyTree : ');
DestroyTree(root);
if root <> nil then
InorderBThr(root){中序遍历线索二杈树的非递归算法}
else
writeln('DestroyTree!');
writeln;
READLN;
END.