dxbinarytree.pas

Well known and usefull component for delphi 7

unit DXBinaryTree;

///////////////////////////////////////////////////////////////////////////////
// Tomes of Delphi: Algorithms and Data Structures
// Source code copyright (c) Julian M Bucknall, 1999-2001
///////////////////////////////////////////////////////////////////////////////

interface

{$WARNINGS OFF}
Type
   TDXDisposeProc=procedure(aData:pointer);
   TDXCompareFunc=function(aData1,aData2:pointer):integer;

Type
  TDXChildType = ({types of children}
    ctLeft, {..left child}
    ctRight); {..right child}

Type
  PDXBinTreeNode = ^TDXBinTreeNode; {binary tree node}
  TDXBinTreeNode = packed record
    btParent:PDXBinTreeNode;
    btChild:array[TDXChildType] of PDXBinTreeNode;
    btData:pointer;
  end;

type
  TDXNodeManager=class
    private
      FNodeSize:cardinal;
    protected
    public
      constructor Create(aNodeSize:cardinal);
      destructor Destroy;override;
      function AllocNode:pointer;
      function AllocNodeClear:pointer;
      procedure FreeNode(aNode:pointer);
  end;

Type
  TDXBinaryTree = class {the binary tree class}
  private
    FCount: integer;
    FDispose: TDXDisposeProc;
    FHead: PDXBinTreeNode;
    BTNodeManager:TDXNodeManager;
  protected
  public
    constructor Create(aDisposeItem: TDXDisposeProc);
    destructor Destroy; override;
    procedure Clear;
    procedure Delete(aNode: PDXBinTreeNode);
    function InsertAt(aParentNode:PDXBinTreeNode;aChildType:TDXChildType;aItem:pointer):PDXBinTreeNode;
    function Root:PDXBinTreeNode;
    property Count:integer read FCount;
  end;

Type
  TDXBinarySearchTree = class {binary search tree class}
  private
    FBinTree:TDXBinaryTree;
    FCompare:TDXCompareFunc;
    FCount:Integer;
  protected
    function bstFindItem(aItem:pointer;var aNode:PDXBinTreeNode;var aChild:TDXChildType):boolean;
    function bstFindNodeToDelete(aItem:pointer):PDXBinTreeNode;
    function bstInsertPrim(aItem:pointer;var aChildType:TDXChildType):PDXBinTreeNode;
  public
    constructor Create(aCompare:TDXCompareFunc;aDispose:TDXDisposeProc);
    destructor Destroy; override;
    procedure Clear;
    procedure Delete(aItem: pointer); virtual;
    function Find(aKeyItem: pointer): pointer; virtual;
    procedure Insert(aItem: pointer); virtual;
    property BinaryTree: TDXBinaryTree read FBinTree;
    property Count:integer read FCount;
  end;

implementation

Uses
   DXString;
   
///////////////////////////////////////////////////////////////////////////////
//
///////////////////////////////////////////////////////////////////////////////
constructor TDXNodeManager.Create(aNodeSize:cardinal);
begin
  inherited Create;
  if (aNodeSize<=sizeof(pointer)) then aNodeSize:=sizeof(pointer)
  else aNodeSize:=((aNodeSize+3) shr 2) shl 2;
  FNodeSize := aNodeSize;
End;

destructor TDXNodeManager.Destroy;
begin
  inherited Destroy;
end;

function TDXNodeManager.AllocNode:pointer;
begin
   GetMem(Result,FNodeSize);
end;

function TDXNodeManager.AllocNodeClear:pointer;
begin
   GetMem(Result,FNodeSize);
   FillChar2(Result^,FNodeSize,#0);
end;

procedure TDXNodeManager.FreeNode(aNode:pointer);
begin
  FreeMem(aNode,FNodeSize);
end;

///////////////////////////////////////////////////////////////////////////////
//
///////////////////////////////////////////////////////////////////////////////
constructor TDXBinaryTree.Create(aDisposeItem: TDXDisposeProc);
begin
   inherited Create;
   FDispose := aDisposeItem;
   BTNodeManager:=TDXNodeManager.Create(sizeof(TDXBinTreeNode));
   FHead:=BTNodeManager.AllocNodeClear;
end;

destructor TDXBinaryTree.Destroy;
begin
  Clear;
  BTNodeManager.FreeNode(FHead);
  inherited Destroy;
end;

type
  PslNode = ^TslNode;      {a node with one link}
  TslNode = packed record
    slnNext : PslNode;
    slnData : pointer;
  end;

type
  TDXStack=class
  private
    FCount:Longint;
    FDispose:TDXDisposeProc;
    FHead:PslNode;
    SLNodeManager:TDXNodeManager; {nodemanager for stacks and queues}
  protected
    procedure sGetNodeManager;
  public
    constructor Create(aDispose:TDXDisposeProc);
    destructor Destroy; override;
    procedure Clear;
    function Examine:pointer;
    function IsEmpty:boolean;
    function Pop: pointer;
    procedure Push(aItem:pointer);
    property Count:longint read FCount;
  end;

constructor TDXStack.Create(aDispose:TDXDisposeProc);
begin
  inherited Create;
  FDispose := aDispose;
  sGetNodeManager;
  FHead:=PslNode(SLNodeManager.AllocNode);
  FHead^.slnNext := nil;
  FHead^.slnData := nil;
end;

destructor TDXStack.Destroy;
begin
  if (Count <> 0) then Clear;
  SLNodeManager.FreeNode(FHead);
  inherited Destroy;
end;

procedure TDXStack.Clear;
var
  Temp: PslNode;
begin
  Temp := FHead^.slnNext;
  while (Temp <> nil) do begin
    FHead^.slnNext := Temp^.slnNext;
    if Assigned(FDispose) then FDispose(Temp^.slnData);
    SLNodeManager.FreeNode(Temp);
    Temp := FHead^.slnNext;
  end;
  FCount := 0;
end;

function TDXStack.Examine: pointer;
begin
  if (Count = 0) then Result:=Nil
  Else Result := FHead^.slnNext^.slnData;
end;

function TDXStack.IsEmpty: boolean;
begin
   Result := (Count = 0);
end;

function TDXStack.Pop: pointer;
var
  Temp: PslNode;

begin
  if (Count=0) then Begin
     Result:=Nil;
     Exit;
  End;
  Temp:=FHead^.slnNext;
  Result:=Temp^.slnData;
  FHead^.slnNext:=Temp^.slnNext;
  SLNodeManager.FreeNode(Temp);
  dec(FCount);
end;

procedure TDXStack.Push(aItem: pointer);
var
  Temp: PslNode;
begin
  Temp:=PslNode(SLNodeManager.AllocNode);
  Temp^.slnData:=aItem;
  Temp^.slnNext:=FHead^.slnNext;
  FHead^.slnNext:=Temp;
  inc(FCount);
end;

procedure TDXStack.sGetNodeManager;
begin
  if (SLNodeManager=nil) then SLNodeManager:=TDXNodeManager.Create(sizeof(TslNode));
end;

procedure TDXBinaryTree.Clear;
var
  Stack: TDXStack;
  Node: PDXBinTreeNode;

begin
   if (FCount = 0) then Exit;
   Stack := TDXStack.Create(nil);
   Stack.Push(FHead^.btChild[ctLeft]);
   while not Stack.IsEmpty do begin
      Node := Stack.Pop;
      if (Node = nil) then begin
         Node:=Stack.Pop;
         if Assigned(FDispose) then FDispose(Node^.btData);
         BTNodeManager.FreeNode(Node);
      end
      else begin
         Stack.Push(Node);
         Stack.Push(nil);
         if (Node^.btChild[ctRight] <> nil) then Stack.Push(Node^.btChild[ctRight]);
         if (Node^.btChild[ctLeft] <> nil) then Stack.Push(Node^.btChild[ctLeft]);
      end;
   end;
   Stack.Free;
   FCount := 0;
   FHead^.btChild[ctLeft]:=nil;
end;

function GetChildType(aNode: PDXBinTreeNode):TDXChildType;
begin
  if (aNode^.btParent^.btChild[ctLeft] = aNode) then Result := ctLeft
  else Result := ctRight;
end;

procedure TDXBinaryTree.Delete(aNode: PDXBinTreeNode);
var
  OurChildsType: TDXChildType;
  OurType: TDXChildType;

begin
  if (aNode = nil) then Exit;
  if (aNode^.btChild[ctLeft] <> nil) then begin
     if (aNode^.btChild[ctRight] <> nil) then Exit;
    OurChildsType := ctLeft;
  end
  else OurChildsType := ctRight;
  OurType:=GetChildType(aNode);
  aNode^.btParent^.btChild[OurType] := aNode^.btChild[OurChildsType];
  if (aNode^.btChild[OurChildsType] <> nil) then
      aNode^.btChild[OurChildsType]^.btParent := aNode^.btParent;
  if Assigned(FDispose) then FDispose(aNode^.btData);
  BTNodeManager.FreeNode(aNode);
  dec(FCount);
end;

function TDXBinaryTree.InsertAt(aParentNode: PDXBinTreeNode;
  aChildType: TDXChildType;
  aItem: pointer):PDXBinTreeNode;
begin
   Result:=Nil;
   if (aParentNode = nil) then begin
      aParentNode := FHead;
      aChildType := ctLeft;
   end;
   if (aParentNode^.btChild[aChildType]<>nil) then Exit;
   Result := BTNodeManager.AllocNode;
   Result^.btParent := aParentNode;
   Result^.btChild[ctLeft] := nil;
   Result^.btChild[ctRight] := nil;
   Result^.btData := aItem;
   aParentNode^.btChild[aChildType] := Result;
   inc(FCount);
end;

function TDXBinaryTree.Root:PDXBinTreeNode;
begin
   Result:=FHead^.btChild[ctLeft];
end;

///////////////////////////////////////////////////////////////////////////////
//
///////////////////////////////////////////////////////////////////////////////
constructor TDXBinarySearchTree.Create(aCompare: TDXCompareFunc;
  aDispose: TDXDisposeProc);
begin
   inherited Create;
   FCompare:=aCompare;
   FBinTree:=TDXBinaryTree.Create(aDispose);
end;

destructor TDXBinarySearchTree.Destroy;
begin
   FBinTree.Free;
   inherited Destroy;
end;

function TDXBinarySearchTree.bstFindItem(aItem:pointer;
   var aNode:PDXBinTreeNode;var aChild:TDXChildType):boolean;

var
   Walker:PDXBinTreeNode;
   CmpResult:Integer;

begin
   Result:=false;
   if (FCount=0) then begin
      aNode:=nil;
      aChild:=ctLeft;
      Exit;
   end;
   Walker:=FBinTree.Root;
   CmpResult:=FCompare(aItem,Walker^.btData);
   while (CmpResult<>0) do begin
      if (CmpResult<0) then begin
         if (Walker^.btChild[ctLeft]=nil) then begin
            aNode:=Walker;
            aChild:=ctLeft;
            Exit;
         end;
         Walker:=Walker^.btChild[ctLeft];
      end
      else begin
         if (Walker^.btChild[ctRight]=nil) then begin
            aNode:=Walker;
            aChild:=ctRight;
            Exit;
         end;
         Walker := Walker^.btChild[ctRight];
      end;
      CmpResult:=FCompare(aItem, Walker^.btData);
   end;
   Result:=true;
   aNode:=Walker;
end;

function TDXBinarySearchTree.bstFindNodeToDelete(aItem:pointer):PDXBinTreeNode;
var
   Walker:PDXBinTreeNode;
   Node:PDXBinTreeNode;
   Temp:pointer;
   ChildType:TDXChildType;

begin
   Result:=Nil;
   if not bstFindItem(aItem,Node,ChildType) then Exit;
   if (Node^.btChild[ctLeft]<>nil) and
      (Node^.btChild[ctRight]<>nil) then begin
      Walker:=Node^.btChild[ctLeft];
      while (Walker^.btChild[ctRight]<>nil) do Walker:=Walker^.btChild[ctRight];
      Temp:=Walker^.btData;
      Walker^.btData:=Node^.btData;
      Node^.btData:=Temp;
      Node:=Walker;
   end;
   Result:=Node;
end;

function TDXBinarySearchTree.bstInsertPrim(aItem:pointer;
  var aChildType:TDXChildType):PDXBinTreeNode;
begin
   if bstFindItem(aItem,Result,aChildType) then Begin
      Result:=Nil;
      Exit;
   End;
   Result:=FBinTree.InsertAt(Result,aChildType,aItem);
   inc(FCount);
end;

procedure TDXBinarySearchTree.Clear;
begin
try
   FBinTree.Clear;
finally
   FCount:=0;
end;
end;

procedure TDXBinarySearchTree.Delete(aItem:pointer);
begin
  FBinTree.Delete(bstFindNodeToDelete(aItem));
  dec(FCount);
end;

function TDXBinarySearchTree.Find(aKeyItem:pointer):pointer;
var
  Node:PDXBinTreeNode;
  ChildType:TDXChildType;

begin
   if bstFindItem(aKeyItem,Node,ChildType) then Result:=Node^.btData
   else Result:=nil;
end;

procedure TDXBinarySearchTree.Insert(aItem:pointer);
var
  ChildType:TDXChildType;

begin
   bstInsertPrim(aItem,ChildType);
end;

end.