AbstractMem TAbstractMemBTree<TData> implementation

Allows to store on an AbstractMem a BTree generic <TData> value that will be overriden using "LoadData" and "SaveData" descendants implementations

src/libraries/abstractmem/UAbstractBTree.pas

@@ -78,7 +78,7 @@ type
     procedure MoveRange(var ASourceNode, ADestNode : TAbstractBTreeNode; AFromSource, ACount, AToDest : Integer);
     procedure MoveRangeBetweenSiblings(var ASourceNode, ADestNode : TAbstractBTreeNode);
     procedure BTreeNodeToString(const ANode : TAbstractBTreeNode; ALevel, ALevelIndex : Integer; const AStrings : TStrings);
-    procedure CheckConsistencyEx(const ANode: TAbstractBTreeNode; AIsGoingDown : Boolean; AParentDataIndexLeft,AParentDataIndexRight : Integer; ADatas: TOrderedList<TData>; AIdents: TOrderedList<TIdentify>; ACurrentLevel : Integer; var ALevels, ANodesCount, AItemsCount : Integer);
+    procedure CheckConsistencyEx(const ANode: TAbstractBTreeNode; AIsGoingDown : Boolean; AParentDataIndexLeft,AParentDataIndexRight : Integer; ADatas: TList<TData>; AIdents: TOrderedList<TIdentify>; ACurrentLevel : Integer; var ALevels, ANodesCount, AItemsCount : Integer);
     function FindPrecessorExt(var ANode : TAbstractBTreeNode; var iPos : Integer) : Boolean;
     function FindSuccessorExt(var ANode : TAbstractBTreeNode; var iPos : Integer) : Boolean;
     procedure EraseTreeExt(var ANode : TAbstractBTreeNode);
@@ -91,15 +91,17 @@ type
     function NewNode : TAbstractBTreeNode; virtual; abstract;
     procedure DisposeNode(var ANode : TAbstractBTreeNode); virtual; abstract;
     procedure SetNil(var AIdentify : TIdentify); virtual; abstract;
-    function BinarySearch(const AData : TData; const ADataArray : TDataArray; out AIndex : Integer) : Boolean;
+    function BinarySearch(const AData : TData; const ADataArray : TDataArray; out AIndex : Integer) : Boolean; virtual;
     function AreEquals(const AIdentify1, AIdentify2 : TIdentify) : Boolean;
     procedure SaveNode(var ANode : TAbstractBTreeNode); virtual; abstract;
     function GetCount : Integer; virtual;
     procedure SetCount(const ANewCount : Integer); virtual;
     function GetHeight: Integer; virtual;
     property Count : Integer read GetCount;
-    procedure CheckConsistencyFinalized(ADatas : TOrderedList<TData>; AIdents : TOrderedList<TIdentify>; Alevels, ANodesCount, AItemsCount : Integer); virtual;
+    procedure CheckConsistencyFinalized(ADatas : TList<TData>; AIdents : TOrderedList<TIdentify>; Alevels, ANodesCount, AItemsCount : Integer); virtual;
     function FindChildPos(const AIdent : TIdentify; const AParent : TAbstractBTreeNode) : Integer;
+    procedure DisposeData(var AData : TData); virtual;
+    function DoCompareData(const ALeftData, ARightData: TData): Integer; virtual;
   public
     property AllowDuplicates : Boolean read FAllowDuplicates write FAllowDuplicates;
     function IsNil(const AIdentify : TIdentify) : Boolean; virtual; abstract;
@@ -145,7 +147,7 @@ type
     procedure DisposeNode(var ANode : TAbstractBTree<Integer,TData>.TAbstractBTreeNode); override;
     procedure SetNil(var AIdentify : Integer); override;
     procedure SaveNode(var ANode : TAbstractBTree<Integer,TData>.TAbstractBTreeNode); override;
-    procedure CheckConsistencyFinalized(ADatas : TOrderedList<TData>; AIdents : TOrderedList<Integer>; Alevels, ANodesCount, AItemsCount : Integer); override;
+    procedure CheckConsistencyFinalized(ADatas : TList<TData>; AIdents : TOrderedList<Integer>; Alevels, ANodesCount, AItemsCount : Integer); override;
   public
     function IsNil(const AIdentify : Integer) : Boolean; override;
     constructor Create(const AOnCompareDataMethod: TComparison<TData>; AAllowDuplicates : Boolean; AOrder : Integer);
@@ -220,7 +222,7 @@ begin
   j := Length(ADataArray)-1;
   while (i <= j) do begin
     mid := (i + j) shr 1;
-    cmp := FOnCompareData(AData,ADataArray[mid]);
+    cmp := DoCompareData(AData,ADataArray[mid]);
     if (cmp<0) then begin
       j := mid - 1;
     end else if (cmp>0) then begin
@@ -266,13 +268,13 @@ end;
 
 procedure TAbstractBTree<TIdentify, TData>.CheckConsistency;
 var
-  FDatas : TOrderedList<TData>;
+  FDatas : TList<TData>;
   FIdents : TOrderedList<TIdentify>;
   Lnode : TAbstractBTreeNode;
   Llevels, LnodesCount, LItemsCount : Integer;
 begin
   FIdents := TOrderedList<TIdentify>.Create(False,FOnCompareIdentify);
-  FDatas := TOrderedList<TData>.Create(FAllowDuplicates,FOnCompareData);
+  FDatas := TList<TData>.Create;
   try
     Llevels := 0;
     LnodesCount := 0;
@@ -291,7 +293,7 @@ begin
   end;
 end;
 
-procedure TAbstractBTree<TIdentify, TData>.CheckConsistencyEx(const ANode: TAbstractBTreeNode; AIsGoingDown : Boolean; AParentDataIndexLeft, AParentDataIndexRight : Integer; ADatas: TOrderedList<TData>; AIdents: TOrderedList<TIdentify>; ACurrentLevel : Integer; var ALevels, ANodesCount, AItemsCount : Integer);
+procedure TAbstractBTree<TIdentify, TData>.CheckConsistencyEx(const ANode: TAbstractBTreeNode; AIsGoingDown : Boolean; AParentDataIndexLeft, AParentDataIndexRight : Integer; ADatas: TList<TData>; AIdents: TOrderedList<TIdentify>; ACurrentLevel : Integer; var ALevels, ANodesCount, AItemsCount : Integer);
 var Lchild : TAbstractBTreeNode;
   i, Lcmp, iLeft, iRight : Integer;
 begin
@@ -308,15 +310,15 @@ begin
     if (ANode.Count=0) then raise EAbstractBTree.Create(Format('Inconsistent NIL node at level %d',[ACurrentLevel]));
     if (AParentDataIndexLeft>=0) then begin
       // Right must be < than parent
-      Lcmp := FOnCompareData(ADatas.Get(AParentDataIndexLeft), ANode.data[0]);
+      Lcmp := DoCompareData(ADatas.Items[AParentDataIndexLeft], ANode.data[0]);
       if Lcmp>0 then raise EAbstractBTree.Create(Format('Inconsistent %d data [%s] vs parent left [%s] at level %d',
-        [Lcmp,NodeDataToString(ANode.data[0]),NodeDataToString(ADatas.Get(AParentDataIndexLeft)), ACurrentLevel]));
+        [Lcmp,NodeDataToString(ANode.data[0]),NodeDataToString(ADatas.Items[AParentDataIndexLeft]), ACurrentLevel]));
     end;
     if (AParentDataIndexRight>=0) then begin
       // Right must be < than parent
-      Lcmp := FOnCompareData(ANode.data[ANode.Count-1],ADatas.Get(AParentDataIndexRight));
+      Lcmp := DoCompareData(ANode.data[ANode.Count-1],ADatas.Items[AParentDataIndexRight]);
       if Lcmp>0 then raise EAbstractBTree.Create(Format('Inconsistent %d data [%s] vs parent right [%s] at level %d',
-        [Lcmp,NodeDataToString(ANode.data[ANode.Count-1]),NodeDataToString(ADatas.Get(AParentDataIndexRight)), ACurrentLevel]));
+        [Lcmp,NodeDataToString(ANode.data[ANode.Count-1]),NodeDataToString(ADatas.Items[AParentDataIndexRight]), ACurrentLevel]));
     end;
   end;
   if (MinItemsPerNode>ANode.Count) or (MaxItemsPerNode<ANode.Count) then begin
@@ -326,7 +328,7 @@ begin
   end;
 
   for i := 1 to ANode.Count-1 do begin
-    if FOnCompareData(ANode.data[i-1],ANode.data[i])>0 then raise EAbstractBTree.Create(Format('Inconsistent data (%d..%d)/%d [%s] > [%s] at level %d',
+    if DoCompareData(ANode.data[i-1],ANode.data[i])>0 then raise EAbstractBTree.Create(Format('Inconsistent data (%d..%d)/%d [%s] > [%s] at level %d',
       [i-1,i,ANode.Count,NodeDataToString(ANode.data[i-1]),NodeDataToString(ANode.data[i]), ACurrentLevel]));
   end;
 
@@ -360,7 +362,7 @@ begin
 
 end;
 
-procedure TAbstractBTree<TIdentify, TData>.CheckConsistencyFinalized(ADatas: TOrderedList<TData>; AIdents: TOrderedList<TIdentify>; Alevels, ANodesCount, AItemsCount: Integer);
+procedure TAbstractBTree<TIdentify, TData>.CheckConsistencyFinalized(ADatas: TList<TData>; AIdents: TOrderedList<TIdentify>; Alevels, ANodesCount, AItemsCount: Integer);
 begin
   //
 end;
@@ -432,8 +434,7 @@ begin
       if (Not LmovingUp) then begin
         BinarySearch(AData,Lparent.data,iPosParent);
       end;
-      if (iPosParent>0) //and (iPosParent<=Lparent.Count)
-        then begin
+      if (iPosParent>0) then begin
         Lleft := GetNode(Lparent.childs[iPosParent-1]);
         // Use Left?
         if Lleft.Count>MinItemsPerNode then begin
@@ -645,6 +646,16 @@ begin
   until (False);
 end;
 
+procedure TAbstractBTree<TIdentify, TData>.DisposeData(var AData: TData);
+begin
+  // Nothing to do
+end;
+
+function TAbstractBTree<TIdentify, TData>.DoCompareData(const ALeftData, ARightData: TData): Integer;
+begin
+  Result := FOnCompareData(ALeftData,ARightData);
+end;
+
 procedure TAbstractBTree<TIdentify, TData>.EraseTree;
 var Lnode : TAbstractBTreeNode;
 begin
@@ -665,7 +676,9 @@ begin
       EraseTreeExt(Lchild);
     end;
   end;
-  SetLength(ANode.childs,0);
+  for i:=0 to Length(ANode.data)-1 do begin
+    DisposeData(ANode.data[i]);
+  end;
   DisposeNode(ANode);
   ClearNode(ANode);
 end;
@@ -745,7 +758,7 @@ begin
     if Result then begin
       APrecessor := Lnode.data[iPos];
     end;
-  until (Not Result) or (Not FAllowDuplicates) or (FOnCompareData(AData,APrecessor)>0);
+  until (Not Result) or (Not FAllowDuplicates) or (DoCompareData(AData,APrecessor)>0);
 end;
 
 function TAbstractBTree<TIdentify, TData>.FindPrecessorExt(var ANode: TAbstractBTreeNode; var iPos: Integer): Boolean;
@@ -797,7 +810,7 @@ begin
     if Result then begin
       ASuccessor := Lnode.data[iPos];
     end;
-  until (Not Result) or (Not FAllowDuplicates) or (FOnCompareData(AData,ASuccessor)<0);
+  until (Not Result) or (Not FAllowDuplicates) or (DoCompareData(AData,ASuccessor)<0);
 end;
 
 function TAbstractBTree<TIdentify, TData>.FindSuccessorExt(var ANode: TAbstractBTreeNode; var iPos: Integer): Boolean;
@@ -1079,7 +1092,7 @@ end;
 
 { TMemoryBTree<TData> }
 
-procedure TMemoryBTree<TData>.CheckConsistencyFinalized(ADatas: TOrderedList<TData>; AIdents: TOrderedList<Integer>; Alevels, ANodesCount, AItemsCount: Integer);
+procedure TMemoryBTree<TData>.CheckConsistencyFinalized(ADatas: TList<TData>; AIdents: TOrderedList<Integer>; Alevels, ANodesCount, AItemsCount: Integer);
 var i,iPos,nDisposed, LDisposedMinPos : Integer;
 begin
   inherited;

src/libraries/abstractmem/UAbstractMemBTree.pas

@@ -0,0 +1,434 @@
+unit UAbstractMemBTree;
+
+{
+  This file is part of AbstractMem framework
+
+  Copyright (C) 2020-2021 Albert Molina - [email protected]
+
+  https://github.com/PascalCoinDev/
+
+  *** BEGIN LICENSE BLOCK *****
+
+  The contents of this files are subject to the Mozilla Public License Version
+  2.0 (the "License"); you may not use this file except in compliance with
+  the License. You may obtain a copy of the License at
+  http://www.mozilla.org/MPL
+
+  Software distributed under the License is distributed on an "AS IS" basis,
+  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+  for the specific language governing rights and limitations under the License.
+
+  The Initial Developer of the Original Code is Albert Molina.
+
+  See ConfigAbstractMem.inc file for more info
+
+  ***** END LICENSE BLOCK *****
+}
+
+{$ifdef FPC}
+  {$mode DELPHI}
+{$endif}
+{$H+}
+
+interface
+
+uses
+  Classes, SysUtils,
+  // NOTE ABOUT FREEPASCAL (2020-03-10)
+  // Current version 3.0.4 does not contain valid support for Generics, using Generics from this:
+  // https://github.com/PascalCoinDev/PascalCoin/tree/master/src/libraries/generics.collections
+  // (Download and set folder as a "units include folder" in compiler options)
+  {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults,{$ELSE}Generics.Collections,Generics.Defaults,{$ENDIF}
+  UOrderedList, UAbstractMem, UAbstractBTree;
+
+{$I ./ConfigAbstractMem.inc }
+
+type
+  EAbstractMemBTree = Class(Exception);
+
+  TAbstractMemBTree = Class( TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition> )
+    // BTree implementation on AbstractMem will use TIdentify and TData as a TAbstractMemPosition (aka pointer inside AbstractMem)
+    // Internal search process will convert TData pointer to final TData value for
+    // comparisions
+  private
+    const CT_MIN_INITIAL_POSITION_SIZE = 16;
+          CT_AbstractMemBTree_Magic = 'AMBT'; // DO NOT LOCALIZE MUST BE 4 BYTES LENGTH
+    var
+    FInitialZone : TAMZone;
+    FrootPosition : TAbstractMemPosition;
+    procedure SaveHeader;
+    function GetNodeSize : Integer;
+  protected
+    FAbstractMem : TAbstractMem;
+    function GetRoot: TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
+    procedure SetRoot(var Value: TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode); override;
+    function NewNode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
+    procedure DisposeNode(var ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode); override;
+    procedure SetNil(var AIdentify : TAbstractMemPosition); override;
+    procedure SaveNode(var ANode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode); override;
+    procedure SetCount(const ANewCount : Integer); override;
+    //
+    // NOTE: inherited classes will need to override DisposeData if Data is not a new AbstractMem memory region that must be freed
+    //
+    procedure DisposeData(var AData : TAbstractMemPosition); override;
+    //
+    // NOTE: inherited classes will need to override DoCompareData function in order to properly compare:
+    // function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
+    //
+  public
+    function IsNil(const AIdentify : TAbstractMemPosition) : Boolean; override;
+    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer); virtual;
+    destructor Destroy; override;
+    function GetNode(AIdentify : TAbstractMemPosition) : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode; override;
+    class function MinAbstractMemInitialPositionSize : Integer;
+    property AbstractMem : TAbstractMem read FAbstractMem;
+  End;
+
+  TAbstractMemBTreeData<TData> = Class(TAbstractMemBTree)
+  private
+    // FLeft_ and FRight_ will be used as a cache for improvement calls on DoCompareData
+    FLeft_Pos, FRight_Pos : TAbstractMemPosition;
+    FLeft_Data, FRight_Data : TData;
+    FSearchTarget : TData;
+    FOnCompareAbstractMemData: TComparison<TData>;
+  protected
+    function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
+    //
+    function LoadData(const APosition : TAbstractMemPosition) : TData; virtual; abstract;
+    function SaveData(const AData : TData) : TAMZone; virtual; abstract;
+  public
+    constructor Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates : Boolean; AOrder : Integer; const AOnCompareAbstractMemDataMethod: TComparison<TData>);
+    function AddData(const AData: TData) : Boolean;
+    function FindData(const AData: TData; var APosition : TAbstractMemPosition) : Boolean;
+    function DeleteData(const AData: TData) : Boolean;
+  End;
+
+
+
+implementation
+
+{ TAbstractMemBTree<TData> }
+
+constructor TAbstractMemBTree.Create(AAbstractMem : TAbstractMem; const AInitialZone: TAMZone; AAllowDuplicates: Boolean;  AOrder: Integer);
+var LBuff : TBytes;
+ i : Integer;
+ LOrder : Integer;
+
+begin
+  FAbstractMem := AAbstractMem;
+  FrootPosition := 0;
+  inherited Create(TComparison_Integer,TComparison_Integer,AAllowDuplicates,AOrder);
+  FCount := 0;
+  //
+  if Not FAbstractMem.GetUsedZoneInfo(AInitialZone.position,False,FInitialZone) then raise EAbstractMemBTree.Create('Cannot capture zone info for initialize');
+  if (FInitialZone.size<MinAbstractMemInitialPositionSize) then raise EAbstractMemBTree.Create(Format('Invalid size %d for initialize',[FInitialZone.size]));
+  SetLength(LBuff,CT_MIN_INITIAL_POSITION_SIZE);
+  FAbstractMem.Read(FInitialZone.position,LBuff[0],Length(LBuff));
+  try
+    // Check magic
+    for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
+      if LBuff[i]<>Ord(CT_AbstractMemBTree_Magic.Chars[i]) then Exit;
+    end;
+    Move(LBuff[4],FrootPosition,4);
+    Move(LBuff[8],FCount,4);
+    LOrder := 0;
+    Move(LBuff[12],LOrder,4);
+    if LOrder<>Order then raise EAbstractMemBTree.Create(Format('Invalid Order %d expected %d',[LOrder,Order]));
+    if ( Not ((FrootPosition=0) and (FCount=0))) then raise EAbstractMemBTree.Create(Format('Invalid initial root %d vs count %d',[FrootPosition,FCount]));
+  finally
+    if FrootPosition<=0 then begin
+      FrootPosition := 0;
+      FCount := 0;
+      for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
+        LBuff[i] := Byte(Ord(CT_AbstractMemBTree_Magic.Chars[i]));
+      end;
+      Move(FrootPosition,LBuff[4],4);
+      Move(FCount,LBuff[8],4);
+      LOrder := Order;
+      Move(LOrder,LBuff[12],4);
+      FAbstractMem.Write(FInitialZone.position,LBuff[0],16);
+      SaveHeader;
+    end;
+  end;
+end;
+
+destructor TAbstractMemBTree.Destroy;
+begin
+  //
+  inherited;
+end;
+
+procedure TAbstractMemBTree.DisposeData(var AData: TAbstractMemPosition);
+begin
+  inherited;
+  // Will be called on EraseTreeEx
+  FAbstractMem.Dispose(AData);
+end;
+
+procedure TAbstractMemBTree.DisposeNode(var ANode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode);
+begin
+  FAbstractMem.Dispose( ANode.identify );
+  ClearNode(ANode);
+end;
+
+function TAbstractMemBTree.GetNode(AIdentify: TAbstractMemPosition): TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+var LBuff : TBytes;
+  LStream : TStream;
+  LByte : Byte;
+  i, LItemsCount, LChildsCount : Integer;
+begin
+  // For each node:
+  // Size = (4+2+2)+(4*MaxItemsPerNode)+(4*MaxChildrenPerNode) = GetNodeSize
+  // 4 Bytes [0..3] : Parent
+  // 1 Byte  [4] : Used items (0..32)
+  // 1 Byte  [5] : Used childs (0 (leaf) or Used Items+1)
+  // 2 Bytes [6..7] : 0 (unusued)
+  // For each item:
+  //   4 Bytes : data (AbstractMemPosition or Data using 4 bytes)
+  // For each children:
+  //   4 Bytes : Children AbstractMem position
+  ClearNode(Result);
+  Result.identify := AIdentify;
+  SetLength(LBuff, GetNodeSize );
+  FAbstractMem.Read(AIdentify,LBuff[0],Length(LBuff));
+  LStream := TMemoryStream.Create;
+  try
+    LStream.Write(LBuff[0],Length(LBuff));
+    LStream.Position := 0;
+    //
+    LStream.Read(Result.parent,4); // Read parent position
+    LStream.Read(LByte,1);
+    LItemsCount := LByte;
+    LStream.Read(LByte,1);
+    LChildsCount := LByte;
+    LStream.Read(LByte,1);
+    Assert(LByte=0);
+    LStream.Read(LByte,1);
+    Assert(LByte=0);
+    if ((LItemsCount=0) and (Result.parent=0) and (LChildsCount=0)) then begin
+      // root without data
+    end else begin
+      if (Result.parent=0) then begin
+        if ((LItemsCount<1) or (LItemsCount>MaxItemsPerNode)) then
+          raise EAbstractMemBTree.Create(Format('Root Node items %d not in range [%d..%d]',[LItemsCount,MinItemsPerNode,MaxItemsPerNode]));
+      end else begin
+        if ((LItemsCount<MinItemsPerNode) or (LItemsCount>MaxItemsPerNode)) then
+          raise EAbstractMemBTree.Create(Format('Node items %d not in range [%d..%d]',[LItemsCount,MinItemsPerNode,MaxItemsPerNode]));
+      end;
+      if ((LChildsCount<>0) and (LChildsCount<>(LItemsCount+1))) then
+        raise EAbstractMemBTree.Create(Format('Node childrens %d not %d+1 in range [%d..%d]',[LChildsCount,LItemsCount,MinChildrenPerNode,MaxChildrenPerNode]));
+    end;
+    // Read items
+    SetLength(Result.data,LItemsCount);
+    SetLength(Result.childs,LChildsCount);
+    for i := 0 to LItemsCount-1 do begin
+      LStream.Read(Result.data[i],4);
+    end;
+    // Read childrens
+    for i := 0 to LChildsCount-1 do begin
+      LStream.Read(Result.childs[i],4);
+    end;
+  finally
+    LStream.Free;
+  end;
+end;
+
+function TAbstractMemBTree.GetNodeSize: Integer;
+begin
+  Result := 8 + (4 * MaxItemsPerNode) + (4 * MaxChildrenPerNode);
+end;
+
+function TAbstractMemBTree.GetRoot: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+begin
+  if FrootPosition>0 then begin
+    Result := GetNode(FrootPosition);
+  end else ClearNode(Result);
+end;
+
+function TAbstractMemBTree.IsNil(const AIdentify: TAbstractMemPosition): Boolean;
+begin
+  Result := AIdentify=0;
+end;
+
+class function TAbstractMemBTree.MinAbstractMemInitialPositionSize: Integer;
+begin
+  Result := CT_MIN_INITIAL_POSITION_SIZE;
+end;
+
+function TAbstractMemBTree.NewNode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode;
+begin
+  ClearNode(Result);
+  Result.identify := FAbstractMem.New(GetNodeSize).position;
+end;
+
+procedure TAbstractMemBTree.SaveHeader;
+var LBuff : TBytes;
+ i : Integer;
+ LOrder : Integer;
+begin
+  SetLength(LBuff,16);
+  for i := 0 to CT_AbstractMemBTree_Magic.Length-1 do begin
+    LBuff[i] := Byte(Ord(CT_AbstractMemBTree_Magic.Chars[i]));
+  end;
+  Move(FrootPosition,LBuff[4],4);
+  Move(FCount,LBuff[8],4);
+  LOrder := Order;
+  Move(LOrder,LBuff[12],4);
+  FAbstractMem.Write(FInitialZone.position,LBuff[0],16);
+end;
+
+procedure TAbstractMemBTree.SaveNode(var ANode: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode);
+var LBuff : TBytes;
+  LStream : TStream;
+  LByte : Byte;
+  i, LItemsCount, LChildsCount : Integer;
+begin
+  if ((ANode.Count)>MaxItemsPerNode) or (Length(ANode.childs)>MaxChildrenPerNode) then begin
+    // Protection agains saving temporal Node info with extra datas or childs
+    Exit;
+  end;
+
+  // See GetNode info
+  LStream := TMemoryStream.Create;
+  try
+    LStream.Write(ANode.parent,4);
+    LItemsCount := Length(ANode.data);
+    LStream.Write(LItemsCount,1);
+    LChildsCount := Length(ANode.childs);
+    LStream.Write(LChildsCount,1);
+    LByte := 0;
+    LStream.Write(LByte,1);
+    LStream.Write(LByte,1);
+    for i := 0 to LItemsCount-1 do begin
+      LStream.Write(ANode.data[i],4)
+    end;
+    // Read childrens
+    for i := 0 to LChildsCount-1 do begin
+      LStream.Write(ANode.childs[i],4);
+    end;
+    SetLength(LBuff,LStream.Size);
+    LStream.Position := 0;
+    LStream.Read(LBuff[0],LStream.Size);
+    FAbstractMem.Write(ANode.identify,LBuff[0],Length(LBuff));
+  finally
+    LStream.Free;
+  end;
+end;
+
+procedure TAbstractMemBTree.SetCount(const ANewCount: Integer);
+begin
+  inherited;
+  SaveHeader;
+end;
+
+procedure TAbstractMemBTree.SetNil(var AIdentify: TAbstractMemPosition);
+begin
+  inherited;
+  AIdentify := 0;
+end;
+
+procedure TAbstractMemBTree.SetRoot(var Value: TAbstractBTree<TAbstractMemPosition, TAbstractMemPosition>.TAbstractBTreeNode);
+begin
+  inherited;
+  FrootPosition := Value.identify;
+  SaveHeader;
+end;
+
+{ TAbstractMemBTreeData<TData> }
+
+function TAbstractMemBTreeData<TData>.AddData(const AData: TData): Boolean;
+var Lzone : TAMZone;
+begin
+  Lzone := SaveData(AData);
+  Result := inherited Add(Lzone.position);
+  if Not Result then begin
+    // Dispose
+    FAbstractMem.Dispose(Lzone);
+  end;
+end;
+
+constructor TAbstractMemBTreeData<TData>.Create(AAbstractMem: TAbstractMem;
+  const AInitialZone: TAMZone; AAllowDuplicates: Boolean; AOrder: Integer;
+  const AOnCompareAbstractMemDataMethod: TComparison<TData>);
+begin
+  inherited Create(AAbstractMem,AInitialZone,AAllowDuplicates,AOrder);
+  FOnCompareAbstractMemData := AOnCompareAbstractMemDataMethod;
+  FLeft_Pos  := 0;
+  FRight_Pos := 0;
+end;
+
+function TAbstractMemBTreeData<TData>.DeleteData(const AData: TData): Boolean;
+var LAbstractMemPos : TAbstractMemPosition;
+begin
+  if FindData(AData,LAbstractMemPos) then begin
+    Delete(LAbstractMemPos);
+    FAbstractMem.Dispose(LAbstractMemPos);
+    Result := True;
+    if FLeft_Pos=LAbstractMemPos then FLeft_Pos := 0;
+    if FRight_Pos=LAbstractMemPos then FRight_Pos := 0;
+  end else Result := False;
+end;
+
+function TAbstractMemBTreeData<TData>.DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer;
+var Ltmp : TData;
+begin
+  Assert((ALeftData<>0) and (ARightData<>0) and (ARightData<>1),Format('DoCompareData: Invalid Left %d or Right %d (data cannot be 0 neither 1)',[ALeftData,ARightData]));
+  if (ALeftData=ARightData) then begin
+    // Comparing same data because stored on same position
+    Exit(0);
+  end;
+  Assert(ALeftData<>ARightData,Format('DoCompareData: Left (%d) and Right (%d) are equals',[ALeftData,ARightData]));
+  if (ALeftData=1) then begin
+    if (FRight_Pos=0) or (FRight_Pos<>ARightData) then begin
+      if (FLeft_Pos=ARightData) then begin
+        Result := FOnCompareAbstractMemData(FSearchTarget,FLeft_Data);
+        Exit;
+      end;
+      FRight_Pos := ARightData;
+      FRight_Data := LoadData(ARightData);
+    end;
+    Result := FOnCompareAbstractMemData(FSearchTarget,FRight_Data);
+  end else begin
+    if (FLeft_Pos=0) or (FLeft_Pos<>ALeftData) then begin
+      if (FRight_Pos=ALeftData) then begin
+        // Use right as left
+        if (FLeft_Pos<>ARightData) then begin
+          // Left is not right, reload
+          FLeft_Pos := ARightData;
+          FLeft_Data := LoadData(ARightData);
+        end;
+        Result := FOnCompareAbstractMemData(FRight_Data,FLeft_Data);
+        Exit;
+      end;
+      FLeft_Pos := ALeftData;
+      FLeft_Data := LoadData(ALeftData);
+    end;
+    if (FRight_Pos=0) or (FRight_Pos<>ARightData) then begin
+      FRight_Pos := ARightData;
+      FRight_data := LoadData(ARightData);
+    end;
+    Result := FOnCompareAbstractMemData(FLeft_data,FRight_data);
+  end;
+end;
+
+function TAbstractMemBTreeData<TData>.FindData(const AData: TData;
+  var APosition: TAbstractMemPosition): Boolean;
+var Lnode : TAbstractBTree<TAbstractMemPosition,TAbstractMemPosition>.TAbstractBTreeNode;
+  LiPosNode : Integer;
+begin
+  // NOTE: This is not multithread protected
+  FSearchTarget := AData;
+  if Find(1,Lnode,LiPosNode) then begin
+    APosition := Lnode.data[LiPosNode];
+    Result := True;
+  end else begin
+    APosition := 0;
+    Result := False;
+  end;
+end;
+
+initialization
+
+finalization
+
+end.

src/libraries/abstractmem/tests/AbstractMem.Tests.dpr

@@ -29,6 +29,7 @@ uses
   UAbstractAVLTree in '..\UAbstractAVLTree.pas',
   UAbstractBTree in '..\UAbstractBTree.pas',
   UAbstractMem in '..\UAbstractMem.pas',
+  UAbstractMemBTree in '..\UAbstractMemBTree.pas',
   UAbstractMemTList in '..\UAbstractMemTList.pas',
   UAVLCache in '..\UAVLCache.pas',
   UCacheMem in '..\UCacheMem.pas',
@@ -36,7 +37,8 @@ uses
   UOrderedList in '..\UOrderedList.pas',
   UCacheMem.Tests in 'src\UCacheMem.Tests.pas',
   UAbstractMem.Tests in 'src\UAbstractMem.Tests.pas',
-  UAbstractBTree.Tests in 'src\UAbstractBTree.Tests.pas';
+  UAbstractBTree.Tests in 'src\UAbstractBTree.Tests.pas',
+  UAbstractMemBTree.Tests in 'src\UAbstractMemBTree.Tests.pas';
 
 {$IF Defined(FPC) and (Defined(CONSOLE_TESTRUNNER))}
 type

src/libraries/abstractmem/tests/src/UAbstractBTree.Tests.pas

@@ -71,18 +71,15 @@ begin
       if Random(2)=0 then begin
         if (Lbt.Add(intValue)) then begin
           inc(nAdds);
-          if Random(100)=0 then begin
-            Lbt.CheckConsistency;
-          end;
         end;
       end else begin
         if Lbt.Delete(intValue) then begin
           inc(nDeletes);
-          if Random(100)=0 then begin
-            Lbt.CheckConsistency;
-          end;
         end;
       end;
+      if Random(100)=0 then begin
+        Lbt.CheckConsistency;
+      end;
     until (nRounds>=AOrder * 10000);
     Lbt.CheckConsistency;
     // Delete mode
@@ -248,15 +245,12 @@ begin
         inc(i);
       end;
       Assert(intValue=valMax,Format('Successor %d<>%d',[intValue,valMax]));
-//      Assert(i=Lregs,Format('Succcessor count %d %d',[i,Lregs]));
       Lbt.FindHighest(intValue);
       i := 1;
       while (Lbt.FindPrecessor(intValue,intValue)) do begin
         inc(i);
       end;
       Assert(intValue=valMin,Format('Precessor %d<>%d',[intValue,valMin]));
-//      Assert(i=Lregs,Format('Precessor count %d %d',[i,Lregs]));
-
     finally
       Lbt.Free;
     end;
@@ -303,7 +297,7 @@ begin
       i :=1;
       while Lbt.Height<Lorder+1 do begin
         intValue := Random(100);
-        DoInsert(intValue); // Lbt.Add(intValue);
+        DoInsert(intValue);
         inc(i);
       end;
 

src/libraries/abstractmem/tests/src/UAbstractMemBTree.Tests.pas

@@ -0,0 +1,300 @@
+unit UAbstractMemBTree.Tests;
+
+{$IFDEF FPC}
+  {$MODE Delphi}
+{$ENDIF}
+
+interface
+
+uses
+   SysUtils,
+   {$IFDEF FPC}
+   fpcunit, testutils, testregistry,
+   {$ELSE}
+   TestFramework,
+   {$ENDIF}
+   {$IFNDEF FPC}System.Generics.Collections,System.Generics.Defaults,{$ELSE}Generics.Collections,Generics.Defaults,{$ENDIF}
+   UAbstractMem,
+   UAbstractBTree, UOrderedList, UAbstractMemBTree;
+
+type
+   TAbstractMemBTreeExampleInteger = Class(TAbstractMemBTree)
+   protected
+     procedure DisposeData(var AData : TAbstractMemPosition); override;
+     function DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer; override;
+   public
+     function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+   End;
+
+   TAbstractMemBTreeExampleString = Class(TAbstractMemBTreeData<String>)
+   protected
+     function LoadData(const APosition : TAbstractMemPosition) : String; override;
+     function SaveData(const AData : String) : TAMZone; override;
+   public
+     function NodeDataToString(const AData : TAbstractMemPosition) : String; override;
+   End;
+
+
+   TestTAbstractMemBTree = class(TTestCase)
+   strict private
+   public
+     procedure SetUp; override;
+     procedure TearDown; override;
+     procedure TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean);
+     procedure TestInfinite_String(AOrder : Integer; AAllowDuplicates : Boolean);
+     procedure TestInfinite(AOrder : Integer);
+     procedure DoCheckAbstractMem(AAbstractMem : TAbstractMem; AUsedBytes : Integer);
+   published
+     procedure TestInfiniteOrder_3;
+     procedure TestInfiniteOrder_4;
+     procedure TestInfiniteOrder_5;
+     procedure TestInfiniteOrder_6;
+     procedure TestInfiniteOrder_7;
+   end;
+
+implementation
+
+{ TAbstractMemBTreeExampleInteger }
+
+procedure TAbstractMemBTreeExampleInteger.DisposeData(var AData: TAbstractMemPosition);
+begin
+  // NOTE: Nothing to do NEITHER to inherit from ancestor
+end;
+
+function TAbstractMemBTreeExampleInteger.DoCompareData(const ALeftData, ARightData: TAbstractMemPosition): Integer;
+begin
+  Result := ALeftData - ARightData;
+end;
+
+function TAbstractMemBTreeExampleInteger.NodeDataToString(const AData: TAbstractMemPosition): String;
+begin
+  Result := IntToStr(AData);
+end;
+
+{ TAbstractMemBTreeExampleString }
+
+function TAbstractMemBTreeExampleString.LoadData(const APosition: TAbstractMemPosition): String;
+var i : Integer;
+  wLength : Word;
+  Lbuff : TBytes;
+begin
+  Result := '';
+  wLength := 0;
+  FAbstractMem.Read(APosition,wLength,2);
+  if wLength<=0 then Exit;
+  SetLength(Lbuff,wLength);
+  FAbstractMem.Read(APosition+2,LBuff[0],wLength);
+  for i:=0 to wLength-1 do begin
+    Result := Result + Char(LBuff[i]);
+  end;
+end;
+
+function TAbstractMemBTreeExampleString.NodeDataToString(const AData: TAbstractMemPosition): String;
+begin
+  Result := LoadData(AData);
+end;
+
+function TAbstractMemBTreeExampleString.SaveData(const AData: String): TAMZone;
+var i : Integer;
+  wLength : Word;
+  Lbuff : TBytes;
+begin
+  wLength := Length(AData);
+  Result := FAbstractMem.New( wLength+2 );
+  SetLength(Lbuff,wLength+2);
+  Move(wLength,Lbuff[0],2);
+  for i:=0 to AData.Length-1 do begin
+    Lbuff[2 + i] := Byte(Char(AData.Chars[i]));
+  end;
+  FAbstractMem.Write(Result.position,Lbuff[0],Length(Lbuff));
+end;
+
+{ TestTAbstractMemBTree }
+
+procedure TestTAbstractMemBTree.DoCheckAbstractMem(AAbstractMem: TAbstractMem; AUsedBytes: Integer);
+var
+  LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount : Integer;
+begin
+  Assert(AAbstractMem.CheckConsistency(Nil,LTotalUsedSize, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount));
+  Assert(LTotalUsedSize=AUsedBytes,Format('Total used %d bytes (%d blocks) different from expected %d bytes - Total free %d bytes (%d blocks)',[LTotalUsedSize, AUsedBytes, LTotalUsedBlocksCount, LTotalLeaksSize, LTotalLeaksBlocksCount]));
+end;
+
+procedure TestTAbstractMemBTree.SetUp;
+begin
+end;
+
+procedure TestTAbstractMemBTree.TearDown;
+begin
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite(AOrder: Integer);
+begin
+  TestInfinite_Integer(AOrder,(AOrder MOD 2)=0);
+  TestInfinite_String(AOrder,(AOrder MOD 2)=0);
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite_Integer(AOrder : Integer; AAllowDuplicates : Boolean);
+var Lbt : TAbstractMemBTreeExampleInteger;
+  Lbts : TAbstractMemBTreeExampleString;
+  Lzone : TAMZone;
+  intValue, nRounds, nAdds, nDeletes, i : Integer;
+  Lnode : TIntegerBTree.TAbstractBTreeNode;
+  Lmem : TAbstractMem;
+  LCurr : String;
+begin
+  Lmem := TMem.Create(0,False);
+  Try
+    {$IFDEF FPC}
+    Randomize;
+    {$ELSE}
+    RandomizeProc(0);
+    {$ENDIF}
+    nRounds := 0;
+    nAdds := 0;
+    nDeletes := 0;
+    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+    Lbt := TAbstractMemBTreeExampleInteger.Create(Lmem,Lzone,AAllowDuplicates,AOrder);
+    try
+      repeat
+        inc(nRounds);
+        intValue := Random(AOrder * 100);
+        if Random(2)=0 then begin
+          if (Lbt.Add(intValue)) then begin
+            inc(nAdds);
+          end;
+        end else begin
+          if Lbt.Delete(intValue) then begin
+            inc(nDeletes);
+          end;
+        end;
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      until (nRounds>=AOrder * 10000);
+      Lbt.CheckConsistency;
+      // Delete mode
+      while Lbt.Count>0 do begin
+        Lnode := Lbt.Root;
+        while (Not Lnode.IsLeaf) and (Random(5)>0) do begin
+          Lnode := Lbt.GetNode(Lnode.childs[Random(Lnode.Count)+1]);
+        end;
+        If Not Lbt.Delete(Lnode.data[Random(Lnode.Count)]) then raise Exception.Create('Not Found to delete!');
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      end;
+      Lbt.CheckConsistency;
+      // Try to re-use
+      for i := 1 to AOrder do begin
+        intValue := Random(AOrder * 100);
+        Assert(Lbt.Add(intValue),Format('Cannot re-use %d/%d and add %d',[i,AOrder,intValue]));
+        Lbt.CheckConsistency;
+      end;
+      Lbt.EraseTree;
+    finally
+      Lbt.Free;
+    end;
+    Lmem.Dispose(Lzone);
+    DoCheckAbstractMem(Lmem,0);
+  Finally
+    Lmem.Free;
+  End;
+end;
+
+procedure TestTAbstractMemBTree.TestInfinite_String(AOrder: Integer; AAllowDuplicates : Boolean);
+var Lbt : TAbstractMemBTreeExampleString;
+  Lzone : TAMZone;
+  intValue, nRounds, nAdds, nDeletes, i : Integer;
+  Lnode : TIntegerBTree.TAbstractBTreeNode;
+  Lmem : TAbstractMem;
+  LCurr : String;
+  LCurrData : String;
+begin
+  Lmem := TMem.Create(0,False);
+  Try
+    {$IFDEF FPC}
+    Randomize;
+    {$ELSE}
+    RandomizeProc(0);
+    {$ENDIF}
+    nRounds := 0;
+    nAdds := 0;
+    nDeletes := 0;
+    Lzone := Lmem.New(TAbstractMemBTree.MinAbstractMemInitialPositionSize);
+    Lbt := TAbstractMemBTreeExampleString.Create(Lmem,Lzone,AAllowDuplicates,AOrder,TComparison_String);
+    try
+      repeat
+        inc(nRounds);
+        intValue := Random(AOrder * 100);
+        if Random(2)=0 then begin
+          if (Lbt.AddData(intValue.ToString)) then begin
+            inc(nAdds);
+          end;
+        end else begin
+          if Lbt.DeleteData(intValue.ToString) then begin
+            inc(nDeletes);
+          end;
+        end;
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      until (nRounds>=AOrder * 10000);
+      Lbt.CheckConsistency;
+      // Delete mode
+      while Lbt.Count>0 do begin
+        Lnode := Lbt.Root;
+        while (Not Lnode.IsLeaf) and (Random(5)>0) do begin
+          Lnode := Lbt.GetNode(Lnode.childs[Random(Lnode.Count)+1]);
+        end;
+        LCurrData := Lbt.LoadData(Lnode.data[Random(Lnode.Count)]);
+        if Not Lbt.DeleteData(LCurrData) then raise EAbstractMemBTree.Create('Not found to delete!');
+        if Random(100)=0 then begin
+          Lbt.CheckConsistency;
+        end;
+      end;
+      Lbt.CheckConsistency;
+      // Try to re-use
+      for i := 1 to AOrder do begin
+        intValue := Random(AOrder * 100);
+        Assert(Lbt.AddData(intValue.ToString),Format('Cannot re-use %d/%d and add %d',[i,AOrder,intValue]));
+        Lbt.CheckConsistency;
+      end;
+      Lbt.EraseTree;
+    finally
+      Lbt.Free;
+    end;
+    Lmem.Dispose(Lzone);
+    DoCheckAbstractMem(Lmem,0);
+  Finally
+    Lmem.Free;
+  End;
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_3;
+begin
+  TestInfinite(3);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_4;
+begin
+  TestInfinite(4);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_5;
+begin
+  TestInfinite(5);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_6;
+begin
+  TestInfinite(6);
+end;
+
+procedure TestTAbstractMemBTree.TestInfiniteOrder_7;
+begin
+  TestInfinite(7);
+end;
+
+initialization
+  RegisterTest(TestTAbstractMemBTree{$IFNDEF FPC}.Suite{$ENDIF});
+end.