pascal语言实现二叉排序树

{/*
  Name: 二叉排序树
  Copyright:始发于goal00001111的专栏；允许自由转载，但必须注明作者和出处
  Author: goal00001111
  Date: 02-12-08 20:23
  Description: 二叉排序树
  包括二叉排序树的创建；先序遍历，中序遍历，后序遍历的递归和非递归算法；
结点的插入，查找和删除，其中删除算法有两种和一个优化算法；还有层序遍历算法；
输出二叉树，分别使用先序和后序算法计算二叉树的深度等。
较为全面的介绍了二叉排序树的基本算法。
*/}
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.