PASCAL语言实现线索二叉树

{/*
  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.