components/lazutils/laz_avl_tree.pp

{ **********************************************************************
    This file is part of the Free Component Library (FCL)
    Copyright (c) 2017 by Mattias Gaertner

    Average Level Tree implementation by Mattias Gaertner

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************

  Author: Mattias Gaertner

  Abstract:
    TAVLTree is an Average Level binary Tree. This binary tree is always
    balanced, so that inserting, deleting and finding a node is performed in
    O(log(#Nodes)).

  Note! This is a copy of avl_tree unit from FPC 3.1.1 from 6th Apr 2017.
        Can be removed when FPC 3.2 is the minimun requirement for Lazarus and LazUtils.
}
unit Laz_AVL_Tree;

{$ifdef FPC}{$mode objfpc}{$endif}{$H+}

interface

{off $DEFINE MEM_CHECK}
{off $DEFINE CheckAVLTreeNodeManager}

uses
  {$IFDEF MEM_CHECK}MemCheck,{$ENDIF}
  Classes, SysUtils;

type
  TAVLTree = class;

  TObjectSortCompare = function(Tree: TAVLTree; Data1, Data2: Pointer): integer of object;

  { TAVLTreeNode }

  TAVLTreeNode = class
  public
    Parent, Left, Right: TAVLTreeNode;
    Balance: integer; // = RightDepth-LeftDepth  -2..+2, after balancing: -1,0,+1
    Data: Pointer;
    function Successor: TAVLTreeNode; // next right
    function Precessor: TAVLTreeNode; // next left
    procedure Clear;
    function TreeDepth: integer; // longest WAY down. e.g. only one node => 0 !
    procedure ConsistencyCheck(Tree: TAVLTree); virtual;
    function GetCount: SizeInt;
  end;
  TAVLTreeNodeClass = class of TAVLTreeNode;
  PAVLTreeNode = ^TAVLTreeNode;

  { TBaseAVLTreeNodeManager }

  TBaseAVLTreeNodeManager = class
  public
    procedure DisposeNode(ANode: TAVLTreeNode); virtual; abstract;
    function NewNode: TAVLTreeNode; virtual; abstract;
  end;

  { TAVLTreeNodeEnumerator }

  TAVLTreeNodeEnumerator = class
  protected
    FCurrent: TAVLTreeNode;
    FLowToHigh: boolean;
    FTree: TAVLTree;
  public
    constructor Create(Tree: TAVLTree; aLowToHigh: boolean = true);
    function GetEnumerator: TAVLTreeNodeEnumerator; inline;
    function MoveNext: Boolean;
    property Current: TAVLTreeNode read FCurrent;
    property LowToHigh: boolean read FLowToHigh;
  end;

  TAVLTree = class
  protected
    FCount: SizeInt;
    FNodeClass: TAVLTreeNodeClass;
    fNodeMgr: TBaseAVLTreeNodeManager;
    fNodeMgrAutoFree: boolean;
    FOnCompare: TListSortCompare;
    FOnObjectCompare: TObjectSortCompare;
    FRoot: TAVLTreeNode;
    procedure BalanceAfterInsert(ANode: TAVLTreeNode);
    procedure BalanceAfterDelete(ANode: TAVLTreeNode);
    procedure DeletingNode({%H-}aNode: TAVLTreeNode); virtual;
    function FindInsertPos(Data: Pointer): TAVLTreeNode;
    procedure Init; virtual;
    procedure NodeAdded({%H-}aNode: TAVLTreeNode); virtual;
    procedure RotateLeft(aNode: TAVLTreeNode); virtual;
    procedure RotateRight(aNode: TAVLTreeNode); virtual;
    procedure SwitchPositionWithSuccessor(aNode, aSuccessor: TAVLTreeNode); virtual;
    procedure SetOnCompare(const AValue: TListSortCompare);
    procedure SetOnObjectCompare(const AValue: TObjectSortCompare);
    procedure SetCompares(const NewCompare: TListSortCompare;
                          const NewObjectCompare: TObjectSortCompare);
    procedure SetNodeClass(const AValue: TAVLTreeNodeClass);
  public
    constructor Create(const OnCompareMethod: TListSortCompare);
    constructor CreateObjectCompare(const OnCompareMethod: TObjectSortCompare);
    constructor Create;
    destructor Destroy; override;
    property OnCompare: TListSortCompare read FOnCompare write SetOnCompare;
    property OnObjectCompare: TObjectSortCompare read FOnObjectCompare write SetOnObjectCompare;
    property NodeClass: TAVLTreeNodeClass read FNodeClass write SetNodeClass; // used for new nodes
    procedure SetNodeManager(NewMgr: TBaseAVLTreeNodeManager;
                             AutoFree: boolean = false);
    function NewNode: TAVLTreeNode; virtual; // create a node outside the tree
    procedure DisposeNode(ANode: TAVLTreeNode); virtual; // free the node outside the tree

    // add, delete, remove, move
    procedure Add(ANode: TAVLTreeNode);
    function Add(Data: Pointer): TAVLTreeNode;
    function AddAscendingSequence(Data: Pointer; LastAdded: TAVLTreeNode;
      var Successor: TAVLTreeNode): TAVLTreeNode;
    procedure Delete(ANode: TAVLTreeNode);
    // JuMa: Turned Remove and RemovePointer into functions.
    function Remove(Data: Pointer): boolean;
    function RemovePointer(Data: Pointer): boolean;
    procedure MoveDataLeftMost(var ANode: TAVLTreeNode);
    procedure MoveDataRightMost(var ANode: TAVLTreeNode);
    procedure Clear;
    procedure FreeAndClear;
    procedure FreeAndDelete(ANode: TAVLTreeNode); virtual;
    function Equals(Obj: TObject): boolean; override; // same as IsEqual(aTree,false)
    function IsEqual(aTree: TAVLTree; CheckDataPointer: boolean): boolean; // checks only keys or Data (references), not the data itself, O(n)
    procedure Assign(aTree: TAVLTree); virtual; // clear and copy all Data (references), O(n)

    // search
    property Root: TAVLTreeNode read fRoot;
    property Count: SizeInt read FCount;
    function Compare(Data1, Data2: Pointer): integer;
    function Find(Data: Pointer): TAVLTreeNode; // O(log(n))
    function FindKey(Key: Pointer;
      const OnCompareKeyWithData: TListSortCompare): TAVLTreeNode; // O(log(n))
    function FindNearestKey(Key: Pointer;
      const OnCompareKeyWithData: TListSortCompare): TAVLTreeNode; // O(log(n))
    function FindSuccessor(ANode: TAVLTreeNode): TAVLTreeNode; inline;
    function FindPrecessor(ANode: TAVLTreeNode): TAVLTreeNode; inline;
    function FindLowest: TAVLTreeNode; // O(log(n))
    function FindHighest: TAVLTreeNode; // O(log(n))
    function FindNearest(Data: Pointer): TAVLTreeNode;
    // search in a tree with duplicates (duplicate means here: Compare function returns 0)
    function FindPointer(Data: Pointer): TAVLTreeNode;
    function FindLeftMost(Data: Pointer): TAVLTreeNode;
    function FindRightMost(Data: Pointer): TAVLTreeNode;
    function FindLeftMostKey(Key: Pointer;
      const OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
    function FindRightMostKey(Key: Pointer;
      const OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
    function FindLeftMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
    function FindRightMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;

    // enumerators
    function GetEnumerator: TAVLTreeNodeEnumerator;
    function GetEnumeratorHighToLow: TAVLTreeNodeEnumerator;

    // consistency
    procedure ConsistencyCheck; virtual; // JuMa: changed to procedure and added "virtual".
    procedure WriteReportToStream(s: TStream);
    function NodeToReportStr(aNode: TAVLTreeNode): string; virtual;
    function ReportAsString: string;
  end;
  TAVLTreeClass = class of TAVLTree;

  { TAVLTreeNodeMemManager }

  TAVLTreeNodeMemManager = class(TBaseAVLTreeNodeManager)
  private
    FFirstFree: TAVLTreeNode;
    FFreeCount: SizeInt;
    FCount: SizeInt;
    FMinFree: SizeInt;
    FMaxFreeRatio: SizeInt;
    {$IFDEF CheckAVLTreeNodeManager}
    FThreadId: TThreadID;
    {$ENDIF}
    procedure SetMaxFreeRatio(NewValue: SizeInt);
    procedure SetMinFree(NewValue: SizeInt);
    procedure DisposeFirstFreeNode;
  public
    procedure DisposeNode(ANode: TAVLTreeNode); override;
    function NewNode: TAVLTreeNode; override;
    property MinimumFreeNode: SizeInt read FMinFree write SetMinFree;
    property MaximumFreeNodeRatio: SizeInt
        read FMaxFreeRatio write SetMaxFreeRatio; // in one eighth steps
    property Count: SizeInt read FCount;
    procedure Clear;
    constructor Create;
    destructor Destroy; override;
  end;

var
  LazNodeMemManager: TAVLTreeNodeMemManager;

implementation

function ComparePointer(Data1, Data2: Pointer): integer;
begin
  if Data1>Data2 then Result:=-1
  else if Data1<Data2 then Result:=1
  else Result:=0;
end;

{ TAVLTreeNodeEnumerator }

constructor TAVLTreeNodeEnumerator.Create(Tree: TAVLTree; aLowToHigh: boolean);
begin
  FTree:=Tree;
  FLowToHigh:=aLowToHigh;
end;

function TAVLTreeNodeEnumerator.GetEnumerator: TAVLTreeNodeEnumerator;
begin
  Result:=Self;
end;

function TAVLTreeNodeEnumerator.MoveNext: Boolean;
begin
  if FLowToHigh then begin
    if FCurrent<>nil then
      FCurrent:=FCurrent.Successor
    else
      FCurrent:=FTree.FindLowest;
  end else begin
    if FCurrent<>nil then
      FCurrent:=FCurrent.Precessor
    else
      FCurrent:=FTree.FindHighest;
  end;
  Result:=FCurrent<>nil;
end;

{ TAVLTree }

function TAVLTree.Add(Data: Pointer): TAVLTreeNode;
begin
  Result:=NewNode;
  Result.Data:=Data;
  Add(Result);
end;

function TAVLTree.AddAscendingSequence(Data: Pointer; LastAdded: TAVLTreeNode;
  var Successor: TAVLTreeNode): TAVLTreeNode;
{ This is an optimized version of "Add" for adding an ascending sequence of
  nodes.
  It uses the LastAdded and Successor to skip searching for an insert position.
  For nodes with same value the order of the sequence is kept.

  Usage:
    LastNode:=nil; // TAvlTreeNode
    Successor:=nil; // TAvlTreeNode
    for i:=1 to 1000 do
      LastNode:=Tree.AddAscendingSequence(TItem.Create(i),LastNode,Successor);
}
var
  InsertPos: TAVLTreeNode;
begin
  Result:=NewNode;
  Result.Data:=Data;
  if (LastAdded<>nil) and (Compare(LastAdded.Data,Data)<=0)
  and ((Successor=nil) or (Compare(Data,Successor.Data)<=0)) then begin
    // Data is between LastAdded and Successor
    inc(FCount);
    if LastAdded.Right=nil then begin
      Result.Parent:=LastAdded;
      LastAdded.Right:=Result;
    end else begin
      InsertPos:=LastAdded.Right;
      while InsertPos.Left<>nil do
        InsertPos:=InsertPos.Left;
      Result.Parent:=InsertPos;
      InsertPos.Left:=Result;
    end;
    NodeAdded(Result);
    BalanceAfterInsert(Result);
  end else begin
    // normal Add
    Add(Result);
    Successor:=Result.Successor;
  end;
end;

function TAVLTree.NewNode: TAVLTreeNode;
begin
  if fNodeMgr<>nil then
    Result:=fNodeMgr.NewNode
  else
    Result:=NodeClass.Create;
end;

procedure TAVLTree.DisposeNode(ANode: TAVLTreeNode);
begin
  if fNodeMgr<>nil then
    fNodeMgr.DisposeNode(ANode)
  else
    ANode.Free;
end;

procedure TAVLTree.Add(ANode: TAVLTreeNode);
// add a node. If there are already nodes with the same value it will be
// inserted rightmost
var InsertPos: TAVLTreeNode;
  InsertComp: integer;
begin
  ANode.Left:=nil;
  ANode.Right:=nil;
  inc(FCount);
  if Root<>nil then begin
    InsertPos:=FindInsertPos(ANode.Data);
    InsertComp:=Compare(ANode.Data,InsertPos.Data);
    ANode.Parent:=InsertPos;
    if InsertComp<0 then begin
      // insert to the left
      InsertPos.Left:=ANode;
    end else begin
      // insert to the right
      InsertPos.Right:=ANode;
    end;
    NodeAdded(ANode);
    BalanceAfterInsert(ANode);
  end else begin
    fRoot:=ANode;
    ANode.Parent:=nil;
    NodeAdded(ANode);
  end;
end;

function TAVLTree.FindLowest: TAVLTreeNode;
begin
  Result:=Root;
  if Result<>nil then
    while Result.Left<>nil do Result:=Result.Left;
end;

function TAVLTree.FindHighest: TAVLTreeNode;
begin
  Result:=Root;
  if Result<>nil then
    while Result.Right<>nil do Result:=Result.Right;
end;

procedure TAVLTree.BalanceAfterDelete(ANode: TAVLTreeNode);
var
  OldParent, OldRight, OldRightLeft, OldLeft, OldLeftRight: TAVLTreeNode;
begin
  while ANode<>nil do begin
    if ((ANode.Balance=+1) or (ANode.Balance=-1)) then exit;
    OldParent:=ANode.Parent;
    if (ANode.Balance=0) then begin
      // Treeheight has decreased by one
      if (OldParent=nil) then
        exit;
      if(OldParent.Left=ANode) then
        Inc(OldParent.Balance)
      else
        Dec(OldParent.Balance);
      ANode:=OldParent;
    end else if (ANode.Balance=+2) then begin
      // Node is overweighted to the right
      OldRight:=ANode.Right;
      if (OldRight.Balance>=0) then begin
        // OldRight.Balance is 0 or -1
        // rotate ANode,OldRight left
        RotateLeft(ANode);
        ANode.Balance:=(1-OldRight.Balance); // toggle 0 and 1
        Dec(OldRight.Balance);
        ANode:=OldRight;
      end else begin
        // OldRight.Balance=-1
        { double rotate
          = rotate OldRightLeft,OldRight right
            and then rotate ANode,OldRightLeft left
                  OldParent                           OldParent
                      |                                  |
                    ANode                           OldRightLeft
                       \                               /      \
                    OldRight             =>          ANode    OldRight
                      /                                \         /
               OldRightLeft                OldRightLeftLeft OldRightLeftRight
                   /     \
        OldRightLeftLeft OldRightLeftRight
        }
        OldRightLeft:=OldRight.Left;
        RotateRight(OldRight);
        RotateLeft(ANode);
        if (OldRightLeft.Balance<=0) then
          ANode.Balance:=0
        else
          ANode.Balance:=-1;
        if (OldRightLeft.Balance>=0) then
          OldRight.Balance:=0
        else
          OldRight.Balance:=+1;
        OldRightLeft.Balance:=0;
        ANode:=OldRightLeft;
      end;
    end else begin
      // Node.Balance=-2
      // Node is overweighted to the left
      OldLeft:=ANode.Left;
      if (OldLeft.Balance<=0) then begin
        // rotate OldLeft,ANode right
        RotateRight(ANode);
        ANode.Balance:=(-1-OldLeft.Balance); // toggle 0 and -1
        Inc(OldLeft.Balance);
        ANode:=OldLeft;
      end else begin
        // OldLeft.Balance = 1
        { double rotate left right
          = rotate OldLeft,OldLeftRight left
            and then rotate OldLeft,ANode right
                    OldParent                           OldParent
                        |                                  |
                      ANode                            OldLeftRight
                       /                               /         \
                    OldLeft             =>          OldLeft    ANode
                       \                                \         /
                   OldLeftRight               OldLeftRightLeft OldLeftRightRight
                     /     \
          OldLeftRightLeft OldLeftRightRight
        }
        OldLeftRight:=OldLeft.Right;
        RotateLeft(OldLeft);
        RotateRight(ANode);
        if (OldLeftRight.Balance>=0) then
          ANode.Balance:=0
        else
          ANode.Balance:=+1;
        if (OldLeftRight.Balance<=0) then
          OldLeft.Balance:=0
        else
          OldLeft.Balance:=-1;
        OldLeftRight.Balance:=0;
        ANode:=OldLeftRight;
      end;
    end;
  end;
end;

procedure TAVLTree.DeletingNode(aNode: TAVLTreeNode);
// called by Delete
// Node.Left=nil or Node.Right=nil
begin
  // for descendants to override
end;

procedure TAVLTree.SetOnObjectCompare(const AValue: TObjectSortCompare);
begin
  if AValue=nil then
    SetCompares(FOnCompare,nil)
  else
    SetCompares(nil,AValue);
end;

procedure TAVLTree.SetCompares(const NewCompare: TListSortCompare;
  const NewObjectCompare: TObjectSortCompare);
var List: PPointer;
  ANode: TAVLTreeNode;
  i, OldCount: integer;
begin
  if (FOnCompare=NewCompare) and (FOnObjectCompare=NewObjectCompare) then exit;
  if Count<=1 then begin
    FOnCompare:=NewCompare;
    FOnObjectCompare:=NewObjectCompare;
    exit;
  end;
  // sort the tree again
  OldCount:=Count;
  GetMem(List,SizeOf(Pointer)*OldCount);
  try
    // save the data in a list
    ANode:=FindLowest;
    i:=0;
    while ANode<>nil do begin
      List[i]:=ANode.Data;
      inc(i);
      ANode:=ANode.Successor;
    end;
    // clear the tree
    Clear;
    // set the new compare function
    FOnCompare:=NewCompare;
    FOnObjectCompare:=NewObjectCompare;
    // re-add all nodes
    for i:=0 to OldCount-1 do
      Add(List[i]);
  finally
    FreeMem(List);
  end;
end;

procedure TAVLTree.SetNodeClass(const AValue: TAVLTreeNodeClass);
begin
  if FNodeClass=AValue then Exit;
  if Count>0 then
    raise Exception.Create(ClassName+'.SetNodeClass Count='+IntToStr(Count)
      +' Old='+fNodeMgr.ClassName+' New='+AValue.ClassName);
  FNodeClass:=AValue;
  if fNodeMgr=LazNodeMemManager then
    fNodeMgr:=nil;
end;

procedure TAVLTree.BalanceAfterInsert(ANode: TAVLTreeNode);
var
  OldParent, OldRight, OldLeft: TAVLTreeNode;
begin
  OldParent:=ANode.Parent;
  while (OldParent<>nil) do begin
    if (OldParent.Left=ANode) then begin
      // Node is left child
      dec(OldParent.Balance);
      if (OldParent.Balance=0) then exit;
      if (OldParent.Balance=-1) then begin
        ANode:=OldParent;
        OldParent:=ANode.Parent;
        continue;
      end;
      // OldParent.Balance=-2
      if (ANode.Balance=-1) then begin
        { rotate ANode,ANode.Parent right
             OldParentParent        OldParentParent
                   |                     |
               OldParent        =>     ANode
                 /                        \
              ANode                     OldParent
                \                        /
              OldRight               OldRight      }
        RotateRight(OldParent);
        ANode.Balance:=0;
        OldParent.Balance:=0;
      end else begin
        // Node.Balance = +1
        { double rotate
          = rotate ANode,OldRight left and then rotate OldRight,OldParent right
             OldParentParent             OldParentParent
                    |                           |
                OldParent                    OldRight
                   /            =>          /        \
                 ANode                   ANode      OldParent
                    \                       \          /
                   OldRight          OldRightLeft  OldRightRight
                     / \
          OldRightLeft OldRightRight
        }
        OldRight:=ANode.Right;
        RotateLeft(ANode);
        RotateRight(OldParent);
        if (OldRight.Balance<=0) then
          ANode.Balance:=0
        else
          ANode.Balance:=-1;
        if (OldRight.Balance=-1) then
          OldParent.Balance:=1
        else
          OldParent.Balance:=0;
        OldRight.Balance:=0;
      end;
      exit;
    end else begin
      // Node is right child
      Inc(OldParent.Balance);
      if (OldParent.Balance=0) then exit;
      if (OldParent.Balance=+1) then begin
        ANode:=OldParent;
        OldParent:=ANode.Parent;
        continue;
      end;
      // OldParent.Balance = +2
      if(ANode.Balance=+1) then begin
        { rotate OldParent,ANode left
             OldParentParent        OldParentParent
                   |                     |
               OldParent        =>     ANode
                    \                   /
                  ANode               OldParent
                   /                      \
                OldLeft                 OldLeft      }
        RotateLeft(OldParent);
        ANode.Balance:=0;
        OldParent.Balance:=0;
      end else begin
        // Node.Balance = -1
        { double rotate
          = rotate OldLeft,ANode right and then rotate OldParent,OldLeft right
             OldParentParent             OldParentParent
                    |                           |
                OldParent                    OldLeft
                     \            =>        /       \
                    ANode               OldParent   ANode
                     /                     \          /
                  OldLeft          OldLeftLeft  OldLeftRight
                    / \
         OldLeftLeft OldLeftRight
        }
        OldLeft:=ANode.Left;
        RotateRight(ANode);
        RotateLeft(OldParent);
        if (OldLeft.Balance>=0) then
          ANode.Balance:=0
        else
          ANode.Balance:=+1;
        if (OldLeft.Balance=+1) then
          OldParent.Balance:=-1
        else
          OldParent.Balance:=0;
        OldLeft.Balance:=0;
      end;
      exit;
    end;
  end;
end;

procedure TAVLTree.Clear;

  procedure DeleteNode(ANode: TAVLTreeNode);
  begin
    if ANode.Left<>nil then DeleteNode(ANode.Left);
    if ANode.Right<>nil then DeleteNode(ANode.Right);
    DisposeNode(ANode);
  end;

// Clear
begin
  if Root<>nil then
    DeleteNode(Root);
  fRoot:=nil;
  FCount:=0;
end;

constructor TAVLTree.Create(const OnCompareMethod: TListSortCompare);
begin
  FOnCompare:=OnCompareMethod;
  Init;
end;

constructor TAVLTree.CreateObjectCompare(
  const OnCompareMethod: TObjectSortCompare);
begin
  FOnObjectCompare:=OnCompareMethod;
  Init;
end;

constructor TAVLTree.Create;
begin
  Create(@ComparePointer);
end;

procedure TAVLTree.Delete(ANode: TAVLTreeNode);
var
  OldParent, Child: TAVLTreeNode;
begin
  {$IFDEF CheckAVLTreeNodeManager}
  OldParent:=ANode;
  while OldParent.Parent<>nil do OldParent:=OldParent.Parent;
  if OldParent<>Root then
    raise Exception.Create('TAVLTree.Delete'); // not my node
  {$ENDIF}
  if (ANode.Left<>nil) and (ANode.Right<>nil) then begin
    // ANode has both: Left and Right
    // Switch ANode position with Successor
    // Because ANode.Right<>nil the Successor is a child of ANode
    SwitchPositionWithSuccessor(ANode,ANode.Successor);
  end;
  // left or right is nil
  DeletingNode(aNode);
  OldParent:=ANode.Parent;
  ANode.Parent:=nil;
  if ANode.Left<>nil then
    Child:=ANode.Left
  else
    Child:=ANode.Right;
  if Child<>nil then
    Child.Parent:=OldParent;
  if (OldParent<>nil) then begin
    // Node has parent
    if (OldParent.Left=ANode) then begin
      // Node is left child of OldParent
      OldParent.Left:=Child;
      Inc(OldParent.Balance);
    end else begin
      // Node is right child of OldParent
      OldParent.Right:=Child;
      Dec(OldParent.Balance);
    end;
    BalanceAfterDelete(OldParent);
  end else begin
    // Node was Root
    fRoot:=Child;
  end;
  dec(FCount);
  DisposeNode(ANode);
end;

function TAVLTree.Remove(Data: Pointer): boolean;
var
  ANode: TAvlTreeNode;
begin
  ANode:=Find(Data);
  if ANode<>nil then begin
    Delete(ANode);
    Result:=true;
  end else
    Result:=false;
end;

function TAVLTree.RemovePointer(Data: Pointer): boolean;
var
  ANode: TAvlTreeNode;
begin
  ANode:=FindPointer(Data);
  if ANode<>nil then begin
    Delete(ANode);
    Result:=true;
  end else
    Result:=false;
end;

destructor TAVLTree.Destroy;
begin
  Clear;
  if fNodeMgrAutoFree then
    FreeAndNil(fNodeMgr);
  inherited Destroy;
end;

function TAVLTree.GetEnumerator: TAVLTreeNodeEnumerator;
begin
  Result:=TAVLTreeNodeEnumerator.Create(Self,true);
end;

function TAVLTree.GetEnumeratorHighToLow: TAVLTreeNodeEnumerator;
begin
  Result:=TAVLTreeNodeEnumerator.Create(Self,false);
end;

function TAVLTree.Find(Data: Pointer): TAVLTreeNode;
var Comp: integer;
begin
  Result:=Root;
  while (Result<>nil) do begin
    Comp:=Compare(Data,Result.Data);
    if Comp=0 then exit;
    if Comp<0 then begin
      Result:=Result.Left
    end else begin
      Result:=Result.Right
    end;
  end;
end;

function TAVLTree.FindKey(Key: Pointer; const OnCompareKeyWithData: TListSortCompare
  ): TAVLTreeNode;
var Comp: integer;
begin
  Result:=Root;
  while (Result<>nil) do begin
    Comp:=OnCompareKeyWithData(Key,Result.Data);
    if Comp=0 then exit;
    if Comp<0 then begin
      Result:=Result.Left
    end else begin
      Result:=Result.Right
    end;
  end;
end;

function TAVLTree.FindNearestKey(Key: Pointer;
  const OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
var Comp: integer;
begin
  Result:=fRoot;
  while (Result<>nil) do begin
    Comp:=OnCompareKeyWithData(Key,Result.Data);
    if Comp=0 then exit;
    if Comp<0 then begin
      if Result.Left<>nil then
        Result:=Result.Left
      else
        exit;
    end else begin
      if Result.Right<>nil then
        Result:=Result.Right
      else
        exit;
    end;
  end;
end;

function TAVLTree.FindLeftMostKey(Key: Pointer;
  const OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
var
  LeftNode: TAVLTreeNode;
begin
  Result:=FindKey(Key,OnCompareKeyWithData);
  if Result=nil then exit;
  repeat
    LeftNode:=Result.Precessor;
    if (LeftNode=nil) or (OnCompareKeyWithData(Key,LeftNode.Data)<>0) then exit;
    Result:=LeftNode;
  until false;
end;

function TAVLTree.FindRightMostKey(Key: Pointer;
  const OnCompareKeyWithData: TListSortCompare): TAVLTreeNode;
var
  RightNode: TAVLTreeNode;
begin
  Result:=FindKey(Key,OnCompareKeyWithData);
  if Result=nil then exit;
  repeat
    RightNode:=Result.Successor;
    if (RightNode=nil) or (OnCompareKeyWithData(Key,RightNode.Data)<>0) then exit;
    Result:=RightNode;
  until false;
end;

function TAVLTree.FindLeftMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
var
  LeftNode: TAVLTreeNode;
  Data: Pointer;
begin
  if ANode<>nil then begin
    Data:=ANode.Data;
    Result:=ANode;
    repeat
      LeftNode:=Result.Precessor;
      if (LeftNode=nil) or (Compare(Data,LeftNode.Data)<>0) then break;
      Result:=LeftNode;
    until false;
  end else begin
    Result:=nil;
  end;
end;

function TAVLTree.FindRightMostSameKey(ANode: TAVLTreeNode): TAVLTreeNode;
var
  RightNode: TAVLTreeNode;
  Data: Pointer;
begin
  if ANode<>nil then begin
    Data:=ANode.Data;
    Result:=ANode;
    repeat
      RightNode:=Result.Successor;
      if (RightNode=nil) or (Compare(Data,RightNode.Data)<>0) then break;
      Result:=RightNode;
    until false;
  end else begin
    Result:=nil;
  end;
end;

function TAVLTree.FindNearest(Data: Pointer): TAVLTreeNode;
var Comp: integer;
begin
  Result:=Root;
  while (Result<>nil) do begin
    Comp:=Compare(Data,Result.Data);
    if Comp=0 then exit;
    if Comp<0 then begin
      if Result.Left<>nil then
        Result:=Result.Left
      else
        exit;
    end else begin
      if Result.Right<>nil then
        Result:=Result.Right
      else
        exit;
    end;
  end;
end;

function TAVLTree.FindPointer(Data: Pointer): TAVLTreeNode;
// same as Find, but not comparing for key, but same Data too
begin
  Result:=FindLeftMost(Data);
  while (Result<>nil) do begin
    if Result.Data=Data then break;
    Result:=Result.Successor;
    if Result=nil then exit;
    if Compare(Data,Result.Data)<>0 then exit(nil);
  end;
end;

function TAVLTree.FindLeftMost(Data: Pointer): TAVLTreeNode;
var
  Left: TAVLTreeNode;
begin
  Result:=Find(Data);
  while (Result<>nil) do begin
    Left:=Result.Precessor;
    if (Left=nil) or (Compare(Data,Left.Data)<>0) then break;
    Result:=Left;
  end;
end;

function TAVLTree.FindRightMost(Data: Pointer): TAVLTreeNode;
var
  Right: TAVLTreeNode;
begin
  Result:=Find(Data);
  while (Result<>nil) do begin
    Right:=Result.Successor;
    if (Right=nil) or (Compare(Data,Right.Data)<>0) then break;
    Result:=Right;
  end;
end;

function TAVLTree.FindInsertPos(Data: Pointer): TAVLTreeNode;
var Comp: integer;
begin
  Result:=Root;
  while (Result<>nil) do begin
    Comp:=Compare(Data,Result.Data);
    if Comp<0 then begin
      if Result.Left<>nil then
        Result:=Result.Left
      else
        exit;
    end else begin
      if Result.Right<>nil then
        Result:=Result.Right
      else
        exit;
    end;
  end;
end;

procedure TAVLTree.Init;
begin
  FNodeClass:=TAVLTreeNode;
end;

procedure TAVLTree.NodeAdded(aNode: TAVLTreeNode);
begin
  // for descendants to override
end;

procedure TAVLTree.RotateLeft(aNode: TAVLTreeNode);
{    Parent                Parent
       |                     |
      Node        =>       OldRight
      /  \                  /
   Left OldRight          Node
          /               /  \
     OldRightLeft      Left OldRightLeft  }
var
  AParent, OldRight, OldRightLeft: TAVLTreeNode;
begin
  OldRight:=aNode.Right;
  OldRightLeft:=OldRight.Left;
  AParent:=aNode.Parent;
  if AParent<>nil then begin
    if AParent.Left=aNode then
      AParent.Left:=OldRight
    else
      AParent.Right:=OldRight;
  end else
    fRoot:=OldRight;
  OldRight.Parent:=AParent;
  aNode.Parent:=OldRight;
  aNode.Right:=OldRightLeft;
  if OldRightLeft<>nil then
    OldRightLeft.Parent:=aNode;
  OldRight.Left:=aNode;
end;

procedure TAVLTree.RotateRight(aNode: TAVLTreeNode);
{       Parent              Parent
          |                   |
         Node        =>     OldLeft
         /   \                 \
    OldLeft  Right            Node
        \                     /  \
   OldLeftRight      OldLeftRight Right  }
var
  AParent, OldLeft, OldLeftRight: TAVLTreeNode;
begin
  OldLeft:=aNode.Left;
  OldLeftRight:=OldLeft.Right;
  AParent:=aNode.Parent;
  if AParent<>nil then begin
    if AParent.Left=aNode then
      AParent.Left:=OldLeft
    else
      AParent.Right:=OldLeft;
  end else
    fRoot:=OldLeft;
  OldLeft.Parent:=AParent;
  aNode.Parent:=OldLeft;
  aNode.Left:=OldLeftRight;
  if OldLeftRight<>nil then
    OldLeftRight.Parent:=aNode;
  OldLeft.Right:=aNode;
end;

procedure TAVLTree.SwitchPositionWithSuccessor(aNode, aSuccessor: TAVLTreeNode);
{ called by delete, when aNode.Left<>nil and aNode.Right<>nil
  Switch ANode position with Successor
  Because ANode.Right<>nil the Successor is a child of ANode }
var
  OldBalance: Integer;
  OldParent, OldLeft, OldRight,
  OldSuccParent, OldSuccLeft, OldSuccRight: TAVLTreeNode;
begin
  OldBalance:=aNode.Balance;
  aNode.Balance:=aSuccessor.Balance;
  aSuccessor.Balance:=OldBalance;

  OldParent:=aNode.Parent;
  OldLeft:=aNode.Left;
  OldRight:=aNode.Right;
  OldSuccParent:=aSuccessor.Parent;
  OldSuccLeft:=aSuccessor.Left;
  OldSuccRight:=aSuccessor.Right;

  if OldParent<>nil then begin
    if OldParent.Left=aNode then
      OldParent.Left:=aSuccessor
    else
      OldParent.Right:=aSuccessor;
  end else
    fRoot:=aSuccessor;
  aSuccessor.Parent:=OldParent;

  if OldSuccParent<>aNode then begin
    if OldSuccParent.Left=aSuccessor then
      OldSuccParent.Left:=aNode
    else
      OldSuccParent.Right:=aNode;
    aSuccessor.Right:=OldRight;
    aNode.Parent:=OldSuccParent;
    if OldRight<>nil then
      OldRight.Parent:=aSuccessor;
  end else begin
    {  aNode            aSuccessor
         \          =>    \
         aSuccessor       aNode  }
    aSuccessor.Right:=aNode;
    aNode.Parent:=aSuccessor;
  end;

  aNode.Left:=OldSuccLeft;
  if OldSuccLeft<>nil then
    OldSuccLeft.Parent:=aNode;
  aNode.Right:=OldSuccRight;
  if OldSuccRight<>nil then
    OldSuccRight.Parent:=aNode;
  aSuccessor.Left:=OldLeft;
  if OldLeft<>nil then
    OldLeft.Parent:=aSuccessor;
end;

function TAVLTree.FindSuccessor(ANode: TAVLTreeNode): TAVLTreeNode;
begin
  if ANode<>nil then
    Result:=ANode.Successor
  else
    Result:=nil;
end;

function TAVLTree.FindPrecessor(ANode: TAVLTreeNode): TAVLTreeNode;
begin
  if ANode<>nil then
    Result:=ANode.Precessor
  else
    Result:=nil;
end;

procedure TAVLTree.MoveDataLeftMost(var ANode: TAVLTreeNode);
var
  LeftMost, PreNode: TAVLTreeNode;
  Data: Pointer;
begin
  if ANode=nil then exit;
  LeftMost:=ANode;
  repeat
    PreNode:=FindPrecessor(LeftMost);
    if (PreNode=nil) or (Compare(ANode,PreNode)<>0) then break;
    LeftMost:=PreNode;
  until false;
  if LeftMost=ANode then exit;
  Data:=LeftMost.Data;
  LeftMost.Data:=ANode.Data;
  ANode.Data:=Data;
  ANode:=LeftMost;
end;

procedure TAVLTree.MoveDataRightMost(var ANode: TAVLTreeNode);
var
  RightMost, PostNode: TAVLTreeNode;
  Data: Pointer;
begin
  if ANode=nil then exit;
  RightMost:=ANode;
  repeat
    PostNode:=FindSuccessor(RightMost);
    if (PostNode=nil) or (Compare(ANode,PostNode)<>0) then break;
    RightMost:=PostNode;
  until false;
  if RightMost=ANode then exit;
  Data:=RightMost.Data;
  RightMost.Data:=ANode.Data;
  ANode.Data:=Data;
  ANode:=RightMost;
end;

procedure TAVLTree.ConsistencyCheck;

  procedure E(Msg: string);
  begin
    raise Exception.Create('TAVLTree.ConsistencyCheck: '+Msg);
  end;

var
  RealCount: SizeInt;
begin
  RealCount:=0;
  if FRoot<>nil then begin
    FRoot.ConsistencyCheck(Self);
    RealCount:=FRoot.GetCount;
  end;
  if Count<>RealCount then
    E('Count<>RealCount');
end;

procedure TAVLTree.FreeAndClear;

  procedure FreeNodeData(ANode: TAVLTreeNode);
  begin
    if ANode=nil then exit;
    FreeNodeData(ANode.Left);
    FreeNodeData(ANode.Right);
    if ANode.Data<>nil then TObject(ANode.Data).Free;
    ANode.Data:=nil;
  end;

// TAVLTree.FreeAndClear
begin
  // free all data
  FreeNodeData(Root);
  // free all nodes
  Clear;
end;

procedure TAVLTree.FreeAndDelete(ANode: TAVLTreeNode);
var OldData: TObject;
begin
  OldData:=TObject(ANode.Data);
  Delete(ANode);
  OldData.Free;
end;

function TAVLTree.Equals(Obj: TObject): boolean;
begin
  if Obj is TAVLTree then
    Result:=IsEqual(TAVLTree(Obj),false)
  else
    Result:=inherited Equals(Obj);
end;

function TAVLTree.IsEqual(aTree: TAVLTree; CheckDataPointer: boolean): boolean;
var
  MyNode, OtherNode: TAVLTreeNode;
begin
  if aTree=Self then exit(true);
  Result:=false;
  if aTree=nil then exit;
  if Count<>aTree.Count then exit;
  if OnCompare<>aTree.OnCompare then exit;
  if OnObjectCompare<>aTree.OnObjectCompare then exit;
  if NodeClass<>aTree.NodeClass then exit;
  MyNode:=FindLowest;
  OtherNode:=aTree.FindLowest;
  while MyNode<>nil do begin
    if OtherNode=nil then exit;
    if CheckDataPointer then begin
      if MyNode.Data<>OtherNode.Data then exit;
    end else begin
      if Compare(MyNode.Data,OtherNode.Data)<>0 then exit;
    end;
    MyNode:=MyNode.Successor;
    OtherNode:=OtherNode.Successor;
  end;
  if OtherNode<>nil then exit;
  Result:=true;
end;

procedure TAVLTree.Assign(aTree: TAVLTree);

  procedure AssignNode(var MyNode: TAVLTreeNode; OtherNode: TAVLTreeNode);
  begin
    MyNode:=NewNode;
    MyNode.Data:=OtherNode.Data;
    MyNode.Balance:=OtherNode.Balance;
    if OtherNode.Left<>nil then begin
      AssignNode(MyNode.Left,OtherNode.Left);
      MyNode.Left.Parent:=MyNode;
    end;
    if OtherNode.Right<>nil then begin
      AssignNode(MyNode.Right,OtherNode.Right);
      MyNode.Right.Parent:=MyNode;
    end;
  end;

begin
  if aTree=nil then
    raise Exception.Create('TAVLTree.Assign aTree=nil');
  if IsEqual(aTree,true) then exit;
  Clear;
  SetCompares(aTree.OnCompare,aTree.OnObjectCompare);
  NodeClass:=aTree.NodeClass;
  if aTree.Root<>nil then
    AssignNode(fRoot,aTree.Root);
  FCount:=aTree.Count;
end;

function TAVLTree.Compare(Data1, Data2: Pointer): integer;
begin
  if Assigned(FOnCompare) then
    Result:=FOnCompare(Data1,Data2)
  else
    Result:=FOnObjectCompare(Self,Data1,Data2);
end;

procedure TAVLTree.WriteReportToStream(s: TStream);

  procedure WriteStr(const Txt: string);
  begin
    if Txt='' then exit;
    s.Write(Txt[1],length(Txt));
  end;

  procedure WriteTreeNode(ANode: TAVLTreeNode);
  var
    b: String;
    IsLeft: boolean;
    AParent: TAVLTreeNode;
    WasLeft: Boolean;
  begin
    if ANode=nil then exit;
    WriteTreeNode(ANode.Right);
    AParent:=ANode;
    WasLeft:=false;
    b:='';
    while AParent<>nil do begin
      if AParent.Parent=nil then begin
        if AParent=ANode then
          b:='--'+b
        else
          b:='  '+b;
        break;
      end;
      IsLeft:=AParent.Parent.Left=AParent;
      if AParent=ANode then begin
        if IsLeft then
          b:='\-'
        else
          b:='/-';
      end else begin
        if WasLeft=IsLeft then
          b:='  '+b
        else
          b:='| '+b;
      end;
      WasLeft:=IsLeft;
      AParent:=AParent.Parent;
    end;
    b:=b+NodeToReportStr(ANode)+LineEnding;
    WriteStr(b);
    WriteTreeNode(ANode.Left);
  end;

// TAVLTree.WriteReportToStream
begin
  WriteStr('-Start-of-AVL-Tree-------------------'+LineEnding);
  WriteTreeNode(fRoot);
  WriteStr('-End-Of-AVL-Tree---------------------'+LineEnding);
end;

function TAVLTree.NodeToReportStr(aNode: TAVLTreeNode): string;
begin
  Result:=Format('%p      Self=%p  Parent=%p  Balance=%d',
             [aNode.Data, Pointer(aNode),Pointer(aNode.Parent), aNode.Balance]);
end;

function TAVLTree.ReportAsString: string;
var ms: TMemoryStream;
begin
  Result:='';
  ms:=TMemoryStream.Create;
  try
    WriteReportToStream(ms);
    ms.Position:=0;
    SetLength(Result,ms.Size);
    if Result<>'' then
      ms.Read(Result[1],length(Result));
  finally
    ms.Free;
  end;
end;

procedure TAVLTree.SetOnCompare(const AValue: TListSortCompare);
begin
  if AValue=nil then
    SetCompares(nil,FOnObjectCompare)
  else
    SetCompares(AValue,nil);
end;

procedure TAVLTree.SetNodeManager(NewMgr: TBaseAVLTreeNodeManager;
  AutoFree: boolean);
// only allowed just after create.
begin
  if fNodeMgr=NewMgr then exit;
  if Count>0 then
    raise Exception.Create('TAVLTree.SetNodeManager');
  if fNodeMgrAutoFree then
    FreeAndNil(fNodeMgr);
  fNodeMgr:=NewMgr;
  fNodeMgrAutoFree:=AutoFree;
end;

{ TAVLTreeNode }

function TAVLTreeNode.TreeDepth: integer;
// longest WAY down. e.g. only one node => 0 !
var LeftDepth, RightDepth: integer;
begin
  if Left<>nil then
    LeftDepth:=Left.TreeDepth+1
  else
    LeftDepth:=0;
  if Right<>nil then
    RightDepth:=Right.TreeDepth+1
  else
    RightDepth:=0;
  if LeftDepth>RightDepth then
    Result:=LeftDepth
  else
    Result:=RightDepth;
end;

procedure TAVLTreeNode.ConsistencyCheck(Tree: TAVLTree);

  procedure E(Msg: string);
  begin
    raise Exception.Create('TAVLTreeNode.ConsistencyCheck: '+Msg);
  end;

var
  LeftDepth: SizeInt;
  RightDepth: SizeInt;
begin
  // test left child
  if Left<>nil then begin
    if Left.Parent<>Self then
      E('Left.Parent<>Self');
    if Tree.Compare(Left.Data,Data)>0 then
      E('Compare(Left.Data,Data)>0');
    Left.ConsistencyCheck(Tree);
  end;
  // test right child
  if Right<>nil then begin
    if Right.Parent<>Self then
      E('Right.Parent<>Self');
    if Tree.Compare(Data,Right.Data)>0 then
      E('Compare(Data,Right.Data)>0');
    Right.ConsistencyCheck(Tree);
  end;
  // test balance
  if Left<>nil then
    LeftDepth:=Left.TreeDepth+1
  else
    LeftDepth:=0;
  if Right<>nil then
    RightDepth:=Right.TreeDepth+1
  else
    RightDepth:=0;
  if Balance<>(RightDepth-LeftDepth) then
    E('Balance['+IntToStr(Balance)+']<>(RightDepth['+IntToStr(RightDepth)+']-LeftDepth['+IntToStr(LeftDepth)+'])');
end;

function TAVLTreeNode.GetCount: SizeInt;
begin
  Result:=1;
  if Left<>nil then inc(Result,Left.GetCount);
  if Right<>nil then inc(Result,Right.GetCount);
end;

function TAVLTreeNode.Successor: TAVLTreeNode;
begin
  Result:=Right;
  if Result<>nil then begin
    while (Result.Left<>nil) do Result:=Result.Left;
  end else begin
    Result:=Self;
    while (Result.Parent<>nil) and (Result.Parent.Right=Result) do
      Result:=Result.Parent;
    Result:=Result.Parent;
  end;
end;

function TAVLTreeNode.Precessor: TAVLTreeNode;
begin
  Result:=Left;
  if Result<>nil then begin
    while (Result.Right<>nil) do Result:=Result.Right;
  end else begin
    Result:=Self;
    while (Result.Parent<>nil) and (Result.Parent.Left=Result) do
      Result:=Result.Parent;
    Result:=Result.Parent;
  end;
end;

procedure TAVLTreeNode.Clear;
begin
  Parent:=nil;
  Left:=nil;
  Right:=nil;
  Balance:=0;
  Data:=nil;
end;


{ TAVLTreeNodeMemManager }

constructor TAVLTreeNodeMemManager.Create;
begin
  {$IFDEF CheckAVLTreeNodeManager}
  FThreadId:=GetCurrentThreadId;
  {$ENDIF}
  inherited Create;
  FFirstFree:=nil;
  FFreeCount:=0;
  FCount:=0;
  FMinFree:=100;
  FMaxFreeRatio:=8; // 1:1
end;

destructor TAVLTreeNodeMemManager.Destroy;
begin
  Clear;
  inherited Destroy;
end;

procedure TAVLTreeNodeMemManager.DisposeNode(ANode: TAVLTreeNode);
begin
  if ANode=nil then exit;
  {$IFDEF CheckAVLTreeNodeManager}
  if GetCurrentThreadId<>FThreadId then
    raise Exception.Create('TAVLTreeNodeMemManager.DisposeNode not thread safe!');
  {$ENDIF}
  if FCount < 0 then
    raise Exception.CreateFmt(
      '%s.DisposeNode: FCount (%d) is negative. Should not happen.'
     +' FFreeCount=%d, FMinFree=%d, FMaxFreeRatio=%d.',
      [ClassName, FCount, FFreeCount, FMinFree, FMaxFreeRatio]);
  if (FFreeCount<FMinFree) or (FFreeCount<((FCount shr 3)*FMaxFreeRatio)) then
  begin
    // add ANode to Free list
    ANode.Clear;
    ANode.Right:=FFirstFree;
    FFirstFree:=ANode;
    inc(FFreeCount);
    if (FFreeCount>(((8+FMaxFreeRatio)*FCount) shr 3)) then begin
      DisposeFirstFreeNode;
      DisposeFirstFreeNode;
    end;
  end else begin
    // free list full -> free the ANode
    ANode.Free;
  end;
  dec(FCount);
end;

function TAVLTreeNodeMemManager.NewNode: TAVLTreeNode;
begin
  {$IFDEF CheckAVLTreeNodeManager}
  if GetCurrentThreadId<>FThreadId then
    raise Exception.Create('TAVLTreeNodeMemManager.NewNode: not thread safe!');
  {$ENDIF}
  if FFirstFree<>nil then begin
    // take from free list
    Result:=FFirstFree;
    FFirstFree:=FFirstFree.Right;
    Result.Right:=nil;
    dec(FFreeCount);
  end else begin
    // free list empty -> create new node
    Result:=TAVLTreeNode.Create;
  end;
  inc(FCount);
end;

procedure TAVLTreeNodeMemManager.Clear;
var ANode: TAVLTreeNode;
begin
  {$IFDEF CheckAVLTreeNodeManager}
  if GetCurrentThreadId<>FThreadId then
    raise Exception.Create('TAVLTreeNodeMemManager.Clear: not thread safe!');
  {$ENDIF}
  while FFirstFree<>nil do begin
    ANode:=FFirstFree;
    FFirstFree:=FFirstFree.Right;
    ANode.Right:=nil;
    ANode.Free;
  end;
  FFreeCount:=0;
end;

procedure TAVLTreeNodeMemManager.SetMaxFreeRatio(NewValue: SizeInt);
begin
  if NewValue<0 then NewValue:=0;
  if NewValue=FMaxFreeRatio then exit;
  FMaxFreeRatio:=NewValue;
end;

procedure TAVLTreeNodeMemManager.SetMinFree(NewValue: SizeInt);
begin
  if NewValue<0 then NewValue:=0;
  if NewValue=FMinFree then exit;
  FMinFree:=NewValue;
end;

procedure TAVLTreeNodeMemManager.DisposeFirstFreeNode;
var OldNode: TAVLTreeNode;
begin
  if FFirstFree=nil then exit;
  OldNode:=FFirstFree;
  FFirstFree:=FFirstFree.Right;
  dec(FFreeCount);
  OldNode.Right:=nil;
  OldNode.Free;
end;


initialization
  LazNodeMemManager:=TAVLTreeNodeMemManager.Create;

finalization
  LazNodeMemManager.Free;
  LazNodeMemManager:=nil;
end.