unit AVLTC;
//*******************************************************
// AVL tree class.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
    Graphics, Dialogs, SysUtils,
    AVLNC;

type
    TAVLTree = class(TObject)
        private
            Root : TAVLNode;
        public
            destructor Destroy; override;
            function NotEmpty : Boolean;
            procedure SetPositions(xmin : Integer; ymin : Integer);
            procedure DrawTree(cvs : TCanvas);
            function NodeAtPoint(X, Y : Integer) : TAVLNode;
            procedure Add(new_id : Integer);
            procedure AddNode(var parent : TAVLNode; new_id : Integer; var grew : Boolean);
            procedure RebalanceLeftGrew(var parent : TAVLNode);
            procedure RebalanceRightGrew(var parent : TAVLNode);
            procedure Remove(target_value : Integer);
            procedure RemoveFromNode(var node : TAVLNode; target_id : Integer; var shrunk : Boolean);
            procedure ReplaceRightmost(var target, parent, repl : TAVLNode; var shrunk : Boolean);
            procedure RebalanceRightShrunk(var node : TAVLNode; var shrunk : Boolean);
            procedure RebalanceLeftShrunk(var node : TAVLNode; var shrunk : Boolean);
    end;

implementation

const
    WID = 40;
    HGT = 16;
    HGAP = 2;
    VGAP = 6;

// Free the nodes.
destructor TAVLTree.Destroy;
begin
    Root.Free;
    inherited Destroy;
end;

// Return True if the tree is not empty.
function TAVLTree.NotEmpty : Boolean;
begin
    Result := (Root <> nil);
end;

// Set the positions for the nodes.
procedure TAVLTree.SetPositions(xmin : Integer; ymin : Integer);
begin
    if (Root <> nil) then Root.SetPosition(xmin, ymin);
end;

// Draw the tree.
procedure TAVLTree.DrawTree(cvs : TCanvas);
begin
    if (Root <> nil) then Root.DrawSubtree(cvs);
end;

// Find the descendant node containing this point.
function TAVLTree.NodeAtPoint(X, Y : Integer) : TAVLNode;
begin
    if (Root = nil) then
        Result := nil
    else
        Result := Root.NodeAtPoint(X, Y);
end;

// Add a new value to the tree.
procedure TAVLTree.Add(new_id : Integer);
var
    grew : Boolean;
begin
    AddNode(Root, new_id, grew);
end;

// Add a new value below the indicated node.
//
// Set grew = True if the subtree rooted at this node grew
// taller. As we back up the tree when the recursions end
// we use grew to decide whether we need to rebalance.
procedure TAVLTree.AddNode(var parent : TAVLNode; new_id : Integer; var grew : Boolean);
begin
    // If this is the bottom of the tree, create the new
    // node and make parent point to it.
    if (parent = nil) then
    begin
        parent := TAVLNode.Create;
        parent.Id := new_id;
        parent.Balance := Balanced;
        grew := True;
        exit;
    end;

    // Continue down the appropriate subtree.
    if (new_id <= parent.Id) then
    begin
        // Insert the child in the left subtree.
        AddNode(parent.LeftChild, new_id, grew);

        // See if we need to rebalance.
        if (not grew) then exit;

        if (parent.Balance = RightHeavy) then
        begin
            // We were right heavy. The left subtree grew
            // so we are balanced and we did not grow.
            parent.Balance := Balanced;
            grew := False;
        end else if (parent.Balance = Balanced) then
        begin
            // We were balanced. The left subtree grew so
            // no we are left heavy. This subtree is still
            // balanced but it grew so we must continue
            // checking balance above.
            parent.Balance := LeftHeavy;
        end else begin
            // We were left heavy. The left subtree grew
            // so we are now left unbalanced. Perform the
            // appropriate rotation to rebalance.
            RebalanceLeftGrew(parent);
            grew := False;
        end; // End checking parent's balance.
    end else begin
        // Insert the child in the right subtree.
        AddNode(parent.RightChild, new_id, grew);

        // See if we need to rebalance.
        if (not grew) then exit;

        if (parent.Balance = LeftHeavy) then
        begin
            // We were left heavy. The right subtree grew
            // so we are balanced and we did not grow.
            parent.Balance := Balanced;
            grew := False;
        end else if (parent.Balance = Balanced) then
        begin
            // We were balanced. The right subtree grew so
            // no we are right heavy. This subtree is still
            // balanced but it grew so we must continue
            // checking balance above.
            parent.Balance := RightHeavy;
        end else begin
            // We were right heavy. The right subtree grew
            // so we are now right unbalanced. Perform the
            // appropriate rotation to rebalance.
            RebalanceRightGrew(parent);
            grew := False;
        end; // End checking parent's balance.
    end; // End if (left subtree) ... else (right subtree) ...
end;

// Perform a right or left-right rotation to rebalance
// the tree at this node.
procedure TAVLTree.RebalanceLeftGrew(var parent : TAVLNode);
var
    child, grandchild : TAVLNode;
begin
    child := parent.LeftChild;
    if (child.Balance = LeftHeavy) then
    begin
        // Right rotation.
        parent.LeftChild := child.RightChild;
        child.RightChild := parent;
        parent.Balance := Balanced;
        parent := child;
    end else begin
        // Left-right rotation.
        grandchild := child.RightChild;
        child.RightChild := grandchild.LeftChild;
        grandchild.LeftChild := child;
        parent.LeftChild := grandchild.RightChild;
        grandchild.RightChild := parent;
        if (grandchild.Balance = LeftHeavy) then
            parent.Balance := RightHeavy
        else
            parent.Balance := Balanced;
        if (grandchild.Balance = RightHeavy) then
            child.Balance := LeftHeavy
        else
            child.Balance := Balanced;
        parent := grandchild;
    end; // End if (R rotation) ... else (LR rotation) ...
    parent.Balance := Balanced;
end;

// Perform a left or right-left rotation to rebalance
// the tree at this node.
procedure TAVLTree.RebalanceRightGrew(var parent : TAVLNode);
var
    child, grandchild : TAVLNode;
begin
    child := parent.RightChild;

    if (child.Balance = RightHeavy) then
    begin
        // Left rotation.
        parent.RightChild := child.LeftChild;
        child.LeftChild := parent;
        parent.Balance := Balanced;
        parent := child;
    end else begin
        // Right-left rotation.
        grandchild := child.LeftChild;
        child.LeftChild := grandchild.RightChild;
        grandchild.RightChild := child;
        parent.RightChild := grandchild.LeftChild;
        grandchild.LeftChild := parent;
        if (grandchild.Balance = RightHeavy) then
            parent.Balance := LeftHeavy
        else
            parent.Balance := Balanced;
        if (grandchild.Balance = LeftHeavy) then
            child.Balance := RightHeavy
        else
            child.Balance := Balanced;
        parent := grandchild;
    end; // End if (R rotation) ... else (RL rotation) ...
    parent.Balance := Balanced;
end;

// Remove a value from the tree.
procedure TAVLTree.Remove(target_value : Integer);
var
    shrunk : Boolean;
begin
    RemoveFromNode(Root, target_value, shrunk);
end;

// Remove a value from below the indicated node.
procedure TAVLTree.RemoveFromNode(var node : TAVLNode; target_id : Integer; var shrunk : Boolean);
var
    target : TAVLNode;
begin
    // If we are at the bottom of the tree, the target is
    // not here.
    if (node = nil) then
    begin
        ShowMessage(Format('Drzewo nie zawiera węzła o wartości %d .',
            [target_id]));
        shrunk := False;
        exit;
    end;

    if (target_id < node.Id) then
    begin
        // Search the left subtree.
        RemoveFromNode(node.LeftChild, target_id, shrunk);
        if (shrunk) then RebalanceLeftShrunk(node, shrunk);
    end else if (target_id > node.Id) then
    begin
        // Search the right subtree.
        RemoveFromNode(node.RightChild, target_id, shrunk);
        if (shrunk) then RebalanceRightShrunk(node, shrunk);
    end else begin
        // This is the target.
        target := node;
        if (node.RightChild = nil) then
        begin
            // node has no children or a left child only.
            node := node.LeftChild;
            shrunk := True;
        end else if (node.LeftChild = nil) then
        begin
            // node has a right child only.
            node := node.RightChild;
            shrunk := True;
        end else begin
            // node has two children.
            ReplaceRightmost(node, node, node.LeftChild, shrunk);
            if (shrunk) then RebalanceLeftShrunk(node, shrunk);
        end; // End replacing the target node in the tree.

        // Free the target node.
        target.LeftChild := nil;
        target.RightChild := nil;
        target.Free;
    end; // End (in left) ... (in right) ... (on target) ...
end;

// Replace the target node with the rightmost descendant
// to its left. Node parent is repl's parent.
procedure TAVLTree.ReplaceRightmost(var target, parent, repl : TAVLNode; var shrunk : Boolean);
var
    old_repl : TAVLNode;
begin
    if (repl.RightChild = nil) then
    begin
        // repl is the node to replace target with.
        // Remember where the node is.
        old_repl := repl;

        // Replace repl with its left child.
        repl := repl.LeftChild;

        // Replace the target with old_repl.
        old_repl.LeftChild := target.LeftChild;
        old_repl.RightChild := target.RightChild;
        old_repl.Balance := target.Balance;
        target := old_repl;

        shrunk := True;
    end else begin
        // Look further down right child branches.
        ReplaceRightmost(target, repl, repl.RightChild, shrunk);
        if (shrunk) then RebalanceRightShrunk(parent.LeftChild, shrunk);
    end;
end;

// Perform right or left-right rotations to rebalance
// after the right branch has shrunk.
procedure TAVLTree.RebalanceRightShrunk(var node : TAVLNode; var shrunk : Boolean);
var
    child, grandchild         : TAVLNode;
    child_bal, grandchild_bal : TBalance;
begin
    if (node.Balance = RightHeavy) then
    begin
        // It was right heavy. Now it is balanced.
        node.Balance := Balanced;
    end else if (node.Balance = Balanced) then
    begin
        // It was balanced. Now it is left heavy.
        node.Balance := LeftHeavy;
        shrunk := False;
    end else begin
        // It was left heavy. Now it is left unbalanced.
        child := node.LeftChild;
        child_bal := child.Balance;
        if (child_bal <> RightHeavy) then
        begin
            // Right rotation.
            node.LeftChild := child.RightChild;
            child.RightChild := node;
            if (child_bal = Balanced) then
            begin
                node.Balance := LeftHeavy;
                child.Balance := RightHeavy;
                shrunk := False;
            end else begin
                node.Balance := Balanced;
                child.Balance := Balanced;
            end;
            node := child;
        end else begin
            // Left-right rotation.
            grandchild := child.RightChild;
            grandchild_bal := grandchild.Balance;
            child.RightChild := grandchild.LeftChild;
            grandchild.LeftChild := child;
            node.LeftChild := grandchild.RightChild;
            grandchild.RightChild := node;
            if (grandchild_bal = LeftHeavy) then
                node.Balance := RightHeavy
            else
                node.Balance := Balanced;
            if (grandchild_bal = RightHeavy) then
                child.Balance := LeftHeavy
            else
                child.Balance := Balanced;
            node := grandchild;
            grandchild.Balance := Balanced;
        end; // End (R rotation) ... else (LR rotation) ...
    end; // End (balanced) ... else (left heavy) ... else (left unbalanced) ...
end;

// Perform left or right-left rotations to rebalance
// after the left branch has shrunk.
procedure TAVLTree.RebalanceLeftShrunk(var node : TAVLNode; var shrunk : Boolean);
var
    child, grandchild         : TAVLNode;
    child_bal, grandchild_bal : TBalance;
begin
    if (node.Balance = LeftHeavy) then
    begin
        // It was left heavy. Now it is balanced.
        node.Balance := Balanced;
    end else if (node.Balance = Balanced) then
    begin
        // It was balanced. Now it is right heavy.
        node.Balance := RightHeavy;
        shrunk := False;
    end else begin
        // It was right heavy. Now it is right unbalanced.
        child := node.RightChild;
        child_bal := child.Balance;
        if (child_bal <> LeftHeavy) then
        begin
            // Left rotation.
            node.RightChild := child.LeftChild;
            child.LeftChild := node;
            if (child_bal = Balanced) then
            begin
                node.Balance := RightHeavy;
                child.Balance := LeftHeavy;
                shrunk := False;
            end else begin
                node.Balance := Balanced;
                child.Balance := Balanced;
            end;
            node := child;
        end else begin
            // Right-left rotation.
            grandchild := child.LeftChild;
            grandchild_bal := grandchild.Balance;
            child.LeftChild := grandchild.RightChild;
            grandchild.RightChild := child;
            node.RightChild := grandchild.LeftChild;
            grandchild.LeftChild := node;
            if (grandchild_bal = RightHeavy) then
                node.Balance := LeftHeavy
            else
                node.Balance := Balanced;
            if (grandchild_bal = LeftHeavy) then
                child.Balance := RightHeavy
            else
                child.Balance := Balanced;
            node := grandchild;
            grandchild.Balance := Balanced;
        end; // End (L rotation) ... else (RL rotation) ...
    end; // End (balanced) ... else (right heavy) ... else (right unbalanced) ...
end;

end.
