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

interface

uses
    Graphics, Dialogs, SysUtils,
    BtreeNC;

type
    TBtree = class(TObject)
        private
            Root : TBtreeNode;
        public
            destructor Destroy; override;
            function NotEmpty : Boolean;
            function TextValue : String;
            procedure Add(new_key : Integer);
            procedure AddNode(var node : TBtreeNode; new_key : Integer; var up_node : TBtreeNode; var up_key : Integer; var split : Boolean);
            procedure AddWithRoom(node, new_child : TBtreeNode; spot, new_key : Integer);
            procedure SplitNode(node : TBtreeNode; spot : Integer; var up_key : Integer; var up_node : TBtreeNode);
            procedure Remove(target_value : Integer);
            procedure RemoveFromNode(node : TBtreeNode; target_id : Integer; var too_small : Boolean);
            procedure SwapNode(node : TBtreeNode; key_num : Integer; down_node : TBtreeNode; var too_small : Boolean);
            procedure TooSmall(parent, child : TBtreeNode; child_num : Integer; var too_small : Boolean);
    end;

implementation

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

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

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

// Return a textual representation of the tree.
function TBtree.TextValue : String;
begin
    if (Root = nil) then
        Result := ''
    else
        Result := Root.TextValue(0);
end;

// Add a new value to the tree.
procedure TBtree.Add(new_key : Integer);
var
    up_node, old_root : TBtreeNode;
    up_key            : Integer;
    split             : Boolean;
begin
    // Add the new item.
    AddNode(Root, new_key, up_node, up_key, split);

    // If the root split, create a new root containing
    // the item that was sent up to the parent.
    if (split) then
    begin
        old_root := Root;
        Root := TBtreeNode.Create;
        Root.Key[1] := up_key;
        Root.Child[0] := old_root;
        Root.Child[1] := up_node;
        Root.NumKeys := 1;
    end;
end;

// Add a new value below the indicated node. If there is
// a split, add the item passed up into this node. If this
// node is then full, split it.
procedure TBtree.AddNode(var node : TBtreeNode; new_key : Integer; var up_node : TBtreeNode; var up_key : Integer; var split : Boolean);
var
    branch : Integer;
begin
    if (node = nil) then
    begin
        // If we're at the bottom of the tree, pass the
        // new key value up to the parent for insertion.
        up_node := nil;
        up_key := new_key;
        split := True;
        exit;
    end;

    // See which branch we should investigate further.
    for branch := 0 to node.NumKeys - 1 do
        if (node.Key[branch + 1] > new_key) then break;

    // Move into the indicated branch.
    AddNode(node.Child[branch], new_key, up_node, up_key, split);

    // If we had a split, deal with it.
    if (split) then
    begin
        if (node.NumKeys < KEYS_PER_NODE) then
        begin
            // There's room to insert the key moved up.
            AddWithRoom(node, up_node, branch + 1, up_key);
            split := False;
        end else begin
            // The node is full. Split it.
            SplitNode(node, branch + 1, up_key, up_node);
        end;
    end;
end;

// Add a key to a node known to have room in it.
procedure TBtree.AddWithRoom(node, new_child : TBtreeNode; spot, new_key : Integer);
var
    i : Integer;
begin
    // Make room for the new entry.
    node.NumKeys := node.NumKeys + 1;
    for i := node.NumKeys downto spot + 1 do
    begin
        node.Key[i] := node.Key[i - 1];
        node.Child[i] := node.Child[i - 1];
    end;

    // Add the new entry.
    node.Key[spot] := new_key;
    node.Child[spot] := new_child;
end;

// Split the node plus the up_key item into two nodes. spot
// indicates where in the node the up_key item belongs.
//
// Return the new node through up_node. Return the key to
// be passed back up through up_key.
procedure TBtree.SplitNode(node : TBtreeNode; spot : Integer; var up_key : Integer; var up_node : TBtreeNode);
var
    i, return_key              : Integer;
    return_node, right_child_0 : TBtreeNode;
begin
    // Create the new node.
    return_node := TBtreeNode.Create;

    if (spot <= ORDER + 1) then
    begin
        // The new item should be in the new left node
        // or it should be passed up.
        if (spot = ORDER + 1) then
        begin
            return_key := up_key;
            right_child_0 := up_node;
        end else begin
            // Save entry number ORDER.
            return_key := node.Key[ORDER];
            right_child_0 := node.Child[ORDER];
            node.Key[ORDER] := 0;
            node.Child[ORDER] := nil;

            // Insert the new item into the left node.
            for i := ORDER downto spot + 1 do
            begin
                node.Key[i] := node.Key[i - 1];
                node.Child[i] := node.Child[i - 1];
            end;
            node.Key[spot] := up_key;
            node.Child[spot] := up_node;
        end;

        // Move items into the right node.
        for i := 1 to ORDER do
        begin
            return_node.Key[i] := node.Key[i + ORDER];
            return_node.Child[i] := node.Child[i + ORDER];
            node.Key[i + ORDER] := 0;
            node.Child[i + ORDER] := nil;
        end;
    end else begin
        // The new item should be in the new right node.
        spot := spot - ORDER - 1;

        return_key := node.Key[ORDER + 1];
        right_child_0 := node.Child[ORDER + 1];
        node.Key[ORDER + 1] := 0;
        node.Child[ORDER + 1] := nil;

        // Move the first set of items into the right node.
        for i := 1 to spot - 1 do
        begin
            return_node.Key[i] := node.Key[i + ORDER + 1];
            return_node.Child[i] := node.Child[i + ORDER + 1];
            node.Key[i + ORDER + 1] := 0;
            node.Child[i + ORDER + 1] := nil;
        end;

        // Put up_key and up_node in the right node.
        return_node.Key[spot] := up_key;
        return_node.Child[spot] := up_node;

        // Put the other items in the right node.
        for i := spot + 1 to ORDER do
        begin
            return_node.Key[i] := node.Key[i + ORDER];
            return_node.Child[i] := node.Child[i + ORDER];
            node.Key[i + ORDER] := 0;
            node.Child[i + ORDER] := nil;
        end;
    end; // End (left or up) ... else (right) ...

    node.NumKeys := ORDER;
    return_node.NumKeys := ORDER;

    return_node.Child[0] := right_child_0;

    up_node := return_node;
    up_key := return_key;
end;

// Remove a value from the tree.
procedure TBtree.Remove(target_value : Integer);
var
    too_small : Boolean;
    old_root  : TBtreeNode;
begin
    // Remove the item.
    RemoveFromNode(Root, target_value, too_small);

    // If the root is empty, remove a level from the tree.
    if (Root.NumKeys < 1) then
    begin
        old_root := Root;
        Root := Root.Child[0];
        old_root.Child[0] := nil;
        old_root.Free;
    end;
end;

// Remove a value from below the indicated node.
procedure TBtree.RemoveFromNode(node : TBtreeNode; target_id : Integer; var too_small : Boolean);
var
    branch, i : Integer;
    match     : Boolean;
    child     : TBtreeNode;
begin
    // If we hit the bottom of the tree, it's not here.
    if (node = nil) then
    begin
        ShowMessage(Format('Drzewo nie zawiera węzła o wartości %d .',
            [target_id]));
        too_small := False;
        exit;
    end;

    // Look for the branch containing the item.
    match := False;
    for branch := 1 to node.NumKeys do
    begin
        if (target_id <= node.Key[branch]) then
        begin
            match := (target_id = node.Key[branch]);
            break;
        end;
    end;

    // child is the branch down which the target lies.
    child := node.Child[branch - 1];

    if (match) then
    begin
        // We found the item. Remove it.
        if (child = nil) then
        begin
            // This is a leaf node. Remove the target.
            node.NumKeys := node.NumKeys - 1;
            too_small := (node.NumKeys < ORDER);
            for i := branch to node.NumKeys do
                node.Key[i] := node.Key[i + 1];
            node.Key[node.NumKeys + 1] := 0;
        end else begin
            // Not a leaf. Swap the item with the
            // rightmost item to the left (in a leaf).
            SwapNode(node, branch, child, too_small);

            // If the child is now too small, rearrange it.
            if (too_small) then
                TooSmall(node, child, branch - 1, too_small);
        end;
    end else begin
        // We haven't found the target yet. Continue down
        // branch child.
        RemoveFromNode(child, target_id, too_small);

        // If the child node is now too small, rearrange it.
        if (too_small) then
            TooSmall(node, child, branch - 1, too_small);
    end;
end;

// Descend rightmost branches from target_node until we
// reach a leaf. Then swap the rightmost child from the
// leaf into position swap_node.
//
// This will make target_node smaller, possibly requiring
// that we merge it.
//
// As the recursion unwinds, check nodes that are shrunk
// to make sure they are not too small.
procedure TBtree.SwapNode(node : TBtreeNode; key_num : Integer; down_node : TBtreeNode; var too_small : Boolean);
var
    rightmost_child : TBtreeNode;
    num             : Integer;
begin
    // Examine down_node's rightmost child.
    num := down_node.NumKeys;
    rightmost_child := down_node.Child[num];

    if (rightmost_child = nil) then
    begin
        // We found a leaf. Make the swap.
        node.Key[key_num] := down_node.Key[num];
        down_node.Key[num] := 0;
        down_node.NumKeys := num - 1;
        too_small := (down_node.NumKeys < ORDER);
    end else begin
        // We have not yet found a leaf. Continue
        // searching downwards.
        SwapNode(node, key_num, rightmost_child, too_small);
        if (too_small) then
            TooSmall(down_node, rightmost_child,
                down_node.NumKeys, too_small);
    end;
end;

// child is too small. It is located in position
// child_num in parent.
//
// If child has a right sibling, try to redistribute items
// between child and the right sibling. If the right
// sibling has too few items (it has exactly ORDER items),
// merge child and the right sibling.
//
// If there is no right sibling, try the left sibling.
//
// If two nodes merge, see if the parent grows too small.
procedure TBtree.TooSmall(parent, child : TBtreeNode; child_num : Integer; var too_small : Boolean);
var
    num_in_parent, num_in_sibling : Integer;
    num_to_move, i                : Integer;
    sibling                       : TBtreeNode;
begin
    num_in_parent := parent.NumKeys;

    // See if there is a right sibling.
    if (child_num < num_in_parent) then
    begin
        // Examine the right sibling.
        child_num := child_num + 1; // Points to the sibling.
        sibling := parent.Child[child_num];
        num_in_sibling := sibling.NumKeys;
        num_to_move := (num_in_sibling - ORDER + 1) div 2;

        // Put the item from parent at end of items in
        // child. Right now it has ORDER - 1 keys.
        child.Key[ORDER] := parent.Key[child_num];
        child.Child[ORDER] := sibling.Child[0];
        sibling.Child[0] := nil;

        if (num_to_move > 0) then
        begin
            // If we have enough items to redistribute,
            // do so. Copy items from sibling to child.
            for i := 1 to num_to_move - 1 do
            begin
                child.Key[i + ORDER] := sibling.Key[i];
                child.Child[i + ORDER] := sibling.Child[i];
                sibling.Key[i] := 0;
                sibling.Child[i] := nil;
            end;

            // Prepare parent.
            parent.Key[child_num] := sibling.Key[num_to_move];
            parent.Child[child_num] := sibling;

            // Fill the hole in the sibling.
            sibling.Child[0] := sibling.Child[num_to_move];
            num_in_sibling := num_in_sibling - num_to_move;
            for i := 1 to num_in_sibling do
            begin
                sibling.Key[i] := sibling.Key[i + num_to_move];
                sibling.Child[i] := sibling.Child[i + num_to_move];
                sibling.Key[i + num_to_move] := 0;
                sibling.Child[i + num_to_move] := nil;
            end;

            // Update the key counts.
            sibling.NumKeys := num_in_sibling;
            child.NumKeys := ORDER - 1 + num_to_move;
            too_small := False;
            // End if enough items to redistribute...
        end else begin
            // To few items to redistribute. Merge.

            // Move entries from sibling to child. It must
            // contain ORDER items.
            for i := 1 to ORDER do
            begin
                child.Key[i + ORDER] := sibling.Key[i];
                child.Child[i + ORDER] := sibling.Child[i];
                sibling.Key[i] := 0;
                sibling.Child[i] := nil;
            end;

            // Fill in the hole in the parent.
            for i := child_num to num_in_parent - 1 do
            begin
                parent.Key[i] := parent.Key[i + 1];
                parent.Child[i] := parent.Child[i + 1];
            end;
            parent.Key[num_in_parent] := 0;
            parent.Child[num_in_parent] := nil;

            // Update the key counts.
            child.NumKeys := KEYS_PER_NODE;
            parent.NumKeys := num_in_parent - 1;

            // Free the sibling node.
            sibling.Free;
            too_small := (parent.NumKeys < ORDER);
        end; // End if (can redistribute) ... else (merge)
    end else begin // End looking at right sibling.
        // There is no right sibling. Try the left.
        sibling := parent.Child[child_num - 1];
        num_in_sibling := sibling.NumKeys + 1;
        num_to_move := (num_in_sibling - ORDER) div 2;

        if (num_to_move > 0) then
        begin
            // If we can redistribute, do so.
            // Make room for the new items in child.
            for i := ORDER - 1 downto 1 do
            begin
                child.Key[i + num_to_move] := child.Key[i];
                child.Child[i + num_to_move] := child.Child[i];
            end;

            // Move an item from the parent into child.
            child.Key[num_to_move] := parent.Key[child_num];
            child.Child[num_to_move] := child.Child[0];

            // Move items from the sibling into child.
            num_in_sibling := num_in_sibling - num_to_move;
            for i := num_to_move - 1 downto 1 do
            begin
                child.Key[i] := sibling.Key[i + num_in_sibling];
                child.Child[i] := sibling.Child[i + num_in_sibling];
                sibling.Key[i + num_in_sibling] := 0;
                sibling.Child[i + num_in_sibling] := nil;
            end;
            child.Child[0] := sibling.Child[num_in_sibling];
            sibling.Child[num_in_sibling] := nil;

            // Revise the sibling's entry in the parent.
            parent.Key[child_num] := sibling.Key[num_in_sibling];

            // Update the key counts.
            sibling.NumKeys := num_in_sibling - 1;
            child.NumKeys := ORDER - 1 + num_to_move;
            too_small := False;
            // End if enough items to redistribute...
        end else begin
            // Too few items to redistribute. Merge.
            // Put the node's parent entry in the sibling.
            sibling.Key[num_in_sibling] := parent.Key[child_num];
            sibling.Child[num_in_sibling] := child.Child[0];
            child.Child[0] := nil;

            // Move items from the node into the sibling.
            for i := 1 to ORDER - 1 do
            begin
                sibling.Key[i + num_in_sibling] := child.Key[i];
                sibling.Child[i + num_in_sibling] := child.Child[i];
                child.Key[i] := 0;
                child.Child[i] := nil;
            end;
            // Update the key counts.
            sibling.NumKeys := KEYS_PER_NODE;
            parent.NumKeys := num_in_parent - 1;
            parent.Key[child_num] := 0;
            parent.Child[child_num] := nil;

            // Free the node.
            child.NumKeys := 0;
            child.Free;
            too_small := (parent.NumKeys < ORDER);
        end; // End if (can redistribute) ... else (merge) ...
    end; // End if (right sibling) ... else (left sibling) ...
end;

end.
