PASCAL实现平衡有序树AVL树

{/*
  Name: PASCAL实现平衡有序树AVL树
  Copyright: 始发于goal00001111的专栏；允许自由转载，但必须注明作者和出处
  Author: goal00001111
  Date: 04-12-08 21:37
  Description:
在排序二叉树的基础上分析了AVL树，AVL树比普通二杈有序树多了一个高度信息，
在进行结点的插入和删除后能保证二叉树的深度不会增加，这样在插入和查找结点时能
保证时间复杂度不超过O（logN）。 AVL树的遍历和查找等操作与二叉排序树是一样的，
只是在创建AVL树，插入和删除结点操作有些不同，特别是插入结点，为了保证左右子树
不失去平衡，引入了“单旋转”或“双旋转”的算法。
本文较为全面的介绍了二叉排序树的基本算法，并提供了一样演示程序。
*/
}
{
也许二杈树是很好用的，在插入和查找的时候时间复杂度一般为O（logN），但如果左右
子树失去平衡，也可能达到O（N）。为了防止这种现象发生，一种解决办法是是左右子树尽量
保持平衡，即建立一种平衡有序树AVL树。   
一棵AVL树是其每个结点的左子树和右子树的高度最多相差1的二杈有序树。空树的高度定义为-1。
AVL树的结点声明；
}
PROGRAM AverageTree (input, output);
CONST
    MAX = 1000; {最大结点数量}
TYPE
    element = char;
    AvlTree = ^node;
    node = record
               data : element;
               height : integer; {比普通二杈有序树多了一个高度信息}
               lc, rc : AvlTree;
           end; {record}
    Ary = array[1..MAX] of element;
CONST
    WIDTH = 2; {输出元素值宽度}
    ENDTAG = '#';
VAR
    a : Ary;
    root: AvlTree;
    length : integer;
    data : element;

{AVL树基本操作}
FUNCTION FindMin_1(t : AvlTree): AvlTree; FORWARD;
FUNCTION FindMin_2(t : AvlTree): AvlTree; FORWARD;
FUNCTION FindMax_1(t : AvlTree): AvlTree; FORWARD;
FUNCTION FindMax_2(t : AvlTree): AvlTree; FORWARD;
FUNCTION Height(p : AvlTree): integer; FORWARD;
FUNCTION InsertNode(var t : AvlTree; s : AvlTree) : boolean; FORWARD;
PROCEDURE CreateTree(var t : AvlTree); FORWARD;
PROCEDURE InsertData(var t : AvlTree; data : element); FORWARD;
FUNCTION DelNode(p : AvlTree) : AvlTree;   FORWARD;
PROCEDURE DeleteData(var t : AvlTree; data : element); FORWARD;
PROCEDURE DestroyTree(var t : AvlTree); FORWARD;
FUNCTION GetMax(n1, n2 : integer): integer; FORWARD;

{寻找结点的最大值和最小值}
{递归算法： }
FUNCTION FindMin_1(t : AvlTree): AvlTree;
    begin
        if t = nil then
            FindMin_1 := nil
        else if t^.lc = nil then
            FindMin_1 := t
        else
            FindMin_1 := FindMin_1(t^.lc);
    end; {FindMin_1}

FUNCTION FindMax_1(t : AvlTree): AvlTree;
    begin
        if t = nil then
            FindMax_1 := nil
        else if t^.rc = nil then
            FindMax_1 := t
        else
            FindMax_1 := FindMax_1(t^.rc);
    end; {FindMax}

{非递归算法：}
FUNCTION FindMin_2(t : AvlTree): AvlTree;
    begin
        if t <> nil then
            while t^.lc <> nil do
                t := t^.lc;
        FindMin_2 := t;
    end; {FindMin_2}

FUNCTION FindMax_2(t : AvlTree): AvlTree;
    begin
        if t <> nil then
            while t^.rc <> nil do
                t := t^.rc;
        FindMax_2 := t;
    end; {FindMax_2}

{返回P点的高度}
FUNCTION Height(p : AvlTree): integer;
    begin
        if p = nil then
            Height := -1
        else
            Height := p^.height;
    end; {Height}

{在对一棵AVL树进行插入操作后，可能会破坏它的平衡条件，因此必须对新的AVL树进行调整，
这里用到了“单旋转”或“双旋转”的算法，分别适用于：
单左旋转（SingleRotateWithLeft）；对结点p的左孩子的左子树进行一次插入
单右旋转（SingleRotateWithRight）；对结点p的右孩子的右子树进行一次插入
双左旋转（DoubleRotateWithLeft）；对结点p的左孩子的右子树进行一次插入
双右旋转（DoubleRotateWithRight）；对结点p的右孩子的左子树进行一次插入
}
FUNCTION SingleRotateWithLeft(k2 : AvlTree): AvlTree; FORWARD;
FUNCTION SingleRotateWithRight(k2 : AvlTree): AvlTree; FORWARD;
FUNCTION DoubleRotateWithLeft(k : AvlTree): AvlTree; FORWARD;
FUNCTION DoubleRotateWithRight(k : AvlTree): AvlTree; FORWARD;

FUNCTION SingleRotateWithLeft(k2 : AvlTree): AvlTree;
    var
        k1 : AvlTree;
    begin
        k1 := k2^.lc;
        k2^.lc := k1^.rc;
        k1^.rc := k2;

        k1^.height := GetMax(Height(k1^.lc), Height(k1^.rc)) + 1;
        k2^.height := GetMax(Height(k2^.lc), Height(k2^.rc)) + 1;

        SingleRotateWithLeft := k1;
    end; {SingleRotateWithLeft}

FUNCTION SingleRotateWithRight(k2 : AvlTree): AvlTree;
    var
        k1 : AvlTree;
    begin
        k1 := k2^.rc;
        k2^.rc := k1^.lc;
        k1^.lc := k2;

        k1^.height := GetMax(Height(k1^.lc), Height(k1^.rc)) + 1;
        k2^.height := GetMax(Height(k2^.lc), Height(k2^.rc)) + 1;

        SingleRotateWithRight := k1;
    end; {SingleRotateWithRight}

FUNCTION DoubleRotateWithLeft(k : AvlTree): AvlTree;
    begin
        k^.lc := SingleRotateWithRight(k^.lc); {对k^.lc进行一次单右旋转}
        DoubleRotateWithLeft := SingleRotateWithLeft(k);{对k进行一次单左旋转}
    end; {DoubleRotateWithLeft}

FUNCTION DoubleRotateWithRight(k : AvlTree): AvlTree;
    begin
        k^.rc := SingleRotateWithLeft(k^.rc); {对k^.rc进行一次单左旋转}
        DoubleRotateWithRight := SingleRotateWithRight(k);{对k进行一次单右旋转}
    end; {DoubleRotateWithRight}

{向AVL树插入结点的操作}
FUNCTION InsertNode(var t : AvlTree; s : AvlTree) : boolean;
    begin {若s->data等于b的根结点的数据域之值，则什么也不做}
        if t = nil then
        begin
            t := s;
            InsertNode := true;
        end {if}
        else if (t^.data > s^.data) and (InsertNode(t^.lc, s) = true) then {成功地把s所指结点插入到左子树中}
        begin
            if (Height(t^.lc) - Height(t^.rc)) > 1 then {若平衡被破坏}
                if t^.lc^.data > s^.data then {若s比T的左孩子小，对T单左旋转}
                    t := SingleRotateWithLeft(t)
                else                          {否则，对T双左旋转}
                    t := DoubleRotateWithLeft(t);
            InsertNode := true;
        end  {else if}
        else if (t^.data < s^.data) and (InsertNode(t^.rc, s) = true) then {成功地把s所指结点插入到右子树中}
        begin
            if (Height(t^.rc) - Height(t^.lc)) > 1 then {若平衡被破坏}
                if t^.rc^.data < s^.data then {若s比T的右孩子大，对T单右旋转}
                    t := SingleRotateWithRight(t)
                else                          {否则，对T双右旋转}
                    t := DoubleRotateWithRight(t);
            InsertNode := true;
        end {else if}
        else {没有成功插入，即s->data等于b的根结点的数据域之值}
            InsertNode := false;

        t^.height := GetMax(Height(t^.lc), Height(t^.rc)) + 1;
    end; {InsertNode}


{向AVL树插入数据的操作}
PROCEDURE InsertData(var t : AvlTree; data : element);
    var
        s : AvlTree;
    begin {创建一个值域为data的新结点s，并将s插入AVL树}
        new(s);
        s^.data := data;
        s^.height := 0;
        s^.lc := nil;
        s^.rc := nil;
        if not(InsertNode(t, s)) then {插入一个结点s，插入失败则收回s的空间}
            dispose(s);
    end; {InsertData}

{生成一棵AVL树（以ENDTAG为结束标志）}
PROCEDURE CreateTree(var t : AvlTree);
    var
        data : element;
        s : AvlTree;
    begin
        t := nil;
        read(data);
        while data <> ENDTAG do
        begin
            new(s);
            s^.data := data;
            s^.height := 0;
            s^.lc := nil;
            s^.rc := nil;
            if not(InsertNode(t, s)) then  {插入一个结点s，插入失败则收回s的空间}
                dispose(s);
            read(data);
        end; {while}
    end; {CreateTree}

{删除结点p}
FUNCTION DelNode(p : AvlTree) : AvlTree;
    var
        r, q : AvlTree;
    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;
            q^.height := GetMax(Height(q^.lc), Height(q^.rc)) + 1;
        end {if}
        else
        begin
            r := p;
            p := p^.rc; {用p的右孩子取代它}
        end; {else}

        dispose(r); {删除r结点}
        if p <> nil then {p非空结点}
            p^.height := GetMax(Height(p^.lc), Height(p^.rc)) + 1;
        DelNode := p;
    end; {DelNode}

{删除值域为data的结点}
PROCEDURE DeleteData(var t : AvlTree; data : element);
    begin
        if t <> nil then
        begin
            if t^.data = data then
                t := DelNode(t)
            else if t^.data > data then
                DeleteData(t^.lc, data)
            else
                DeleteData(t^.rc, data);
        end; {else}
    end; {DeleteData}

{销毁一棵AVL树}
PROCEDURE DestroyTree(var t : AvlTree);
    begin
        if t <> nil then
        begin
            DestroyTree(t^.lc);
            DestroyTree(t^.rc);
            dispose(t);
            t := nil;
        end; {if}
    end; {DestroyTree}

FUNCTION GetMax(n1, n2 : integer): integer;
    begin
        if n1 > n2 then
            GetMax := n1
        else
            GetMax := n2;
    end; {GetMax}

{AVL树应用示例:
输入一组数,存储到AVL树中,并进行输出
}
FUNCTION Input(var a : Ary): integer; FORWARD; {输入数据到数组,未排序}
PROCEDURE PrintArray(a : Ary; len : integer); FORWARD;{输出数组}
PROCEDURE Sort(var t : AvlTree; a : Ary; len : integer);  FORWARD;{对数组排序，存储到AVL树}
PROCEDURE Inorder(t : AvlTree); FORWARD; {中序遍历AVL树}
PROCEDURE LevelPrint(t : AvlTree); FORWARD; {层序遍历AVL树}

{输入数据到数组,未排序}
FUNCTION Input(var a : Ary): integer;
    var
        data : element;
        i : integer;
    begin
        i := 1;
        read(data);
        while data <> ENDTAG do
        begin
            a[i] := data;
            inc(i);
            read(data);
        end; {while}

        Input := i - 1;
    end; {Input}

{输出数组}
PROCEDURE PrintArray(a : Ary; len : integer);
    var
        i : integer;
    begin
        for i:=1 to len do
            write(a[i]:WIDTH);
        writeln;
    end; {PrintArray}

{对数组排序，存储到AVL树}
PROCEDURE Sort(var t : AvlTree; a : Ary; len : integer);
    var
        i : integer;
    begin
        for i:=1 to len do
            InsertData(t, a[i]);
    end; {Sort}

{中序遍历}
PROCEDURE Inorder(t : AvlTree);
    begin
        if t <> nil then
        begin
            Inorder(t^.lc); {遍历左子树}
            write(t^.data:WIDTH); {输出该结点（根结点）}
            Inorder(t^.rc); {遍历右子树}
        end;
    end; {Inorder}

{层序遍历：
使用循环队列记录结点的层次，设levelUp为上次打印结点层号，level为本层打印结点层号
}
PROCEDURE LevelPrint(t : AvlTree);
    type
        levelNode = record
                        level : integer;
                        pointer : AvlTree;
                    end;
    var
        p : AvlTree;  {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}

BEGIN {main}
    length := Input(a);
    PrintArray(a, length);
    writeln;
    Sort(root, a, length);
    Inorder(root);
    writeln;
    LevelPrint(root);
    writeln;
    write('MAX : ');
    writeln(FindMax_1(root)^.data);
    write('MIN : ');
    writeln(FindMin_1(root)^.data);
    write('MAX : ');
    writeln(FindMax_2(root)^.data);
    write('MIN : ');
    writeln(FindMin_2(root)^.data);
    writeln;
    READLN;
    write('input delete data:');
    read(data);
    readln;
    DeleteData(root, data);
    writeln;
    LevelPrint(root);
    writeln;
    writeln('DestroyTree : ');
    DestroyTree(root);
    if root <> nil then
        LevelPrint(root)
    else
        writeln('DestroyTree!');
    writeln;

    write('CreateTree:');
    CreateTree(root);
    readln;  writeln;
    Inorder(root);
    writeln;  writeln;
    LevelPrint(root);
    writeln;
    write('input delete data:');
    read(data);
    while (root <> nil) and (data <> ENDTAG) do
    begin
        DeleteData(root, data);
        writeln;  writeln;
        Inorder(root);
        writeln;  writeln;
        LevelPrint(root);
        writeln;
        write('input delete data:');
        readln;
        read(data);
        writeln;
    end; {while}

    READLN;  READLN;
END.