ezdslbtr.pas

Eazy Data Structures library for Delphi.

          end
          else begin
            Stack.Push(Sentinel);
            if (Walker^.TLink[cRight] <> nil) then
              Stack.Push(Walker^.TLink[cRight]);
            if (Walker^.TLink[cLeft] <> nil) then
              Stack.Push(Walker^.TLink[cLeft]);
          end;
        until (Stack.IsEmpty);
      finally
        Stack.Free;
      end;{try..finally}
      btRt^.TLink[CRight] := nil;
    end;
  end;
  if acInDone then
    if Assigned(btRt) then
      acDisposeNode(btRt);
end;
{--------}
function TBinTree.Erase(Cursor : TTreeCursor) : TTreeCursor;
begin
  if IsDataOwner then
    DisposeData(Examine(Cursor));
  Result := Delete(Cursor);
end;
{--------}
function TBinTree.Examine(Cursor : TTreeCursor) : pointer;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsEmpty, ascEmptyExamine);
  EZAssert(not IsLeaf(Cursor), ascExamineLeaf);
  {$ENDIF}
  Result := GetNode(Cursor)^.Data;
end;
{--------}
procedure TBinTree.Insert(var Cursor : TTreeCursor; aData : pointer);
var
  Node : PNode;
begin
  if not IsLeaf(Cursor) then
    RaiseError(escInsInvalidHere);
  Node := acNewNode(aData);
  btInsertPrim(Cursor, Node);
end;
{--------}
function TBinTree.IsLeaf(Cursor : TTreeCursor) : boolean;
begin
  Result := GetNode(Cursor) = nil;
end;
{--------}
function TBinTree.IsRoot(Cursor : TTreeCursor) : boolean;
begin
  Result := Dad(Cursor) = btRt;
end;
{--------}
function TBinTree.Iterate(Action : TIterator; Backwards : boolean;
                           ExtraData : pointer) : TTreeCursor;
const
  Sentinel = nil;
  {------}
  function TraverseLevelOrder : TTreeCursor;
  var
    Finished : boolean;
    Walker   : PNode;
    Queue    : TQueue;
  begin
    TraverseLevelOrder := 0;
    Finished := false;
    Queue := TQueue.Create(false);
    try
      Queue.Append(btRt^.TLink[cRight]);
      repeat
        Walker := PNode(Queue.Pop);
        if not Action(Self, Walker^.Data, ExtraData) then begin
          TraverseLevelOrder := Bleach(Walker^.PKC);
          Finished := true;
        end
        else if Backwards then begin
          if (Walker^.TLink[cRight] <> nil) then
            Queue.Append(Walker^.TLink[cRight]);
          if (Walker^.TLink[cLeft] <> nil) then
            Queue.Append(Walker^.TLink[cLeft]);
        end
        else begin
          if (Walker^.TLink[cLeft] <> nil) then
            Queue.Append(Walker^.TLink[cLeft]);
          if (Walker^.TLink[cRight] <> nil) then
            Queue.Append(Walker^.TLink[cRight]);
        end;
      until Finished or Queue.IsEmpty;
    finally
      Queue.Free;
    end;{try..finally}
  end;
  {------}
  function TraversePreOrderRecurse(Walker : TTreeCursor) : TTreeCursor;
  begin
    Result := 0;
    if not IsLeaf(Walker) then
      if not Action(Self, Examine(Walker), ExtraData) then
        Result := Walker
      else begin
        Result := TraversePreOrderRecurse(Left(Walker));
        if (Result = 0) then
          Result := TraversePreOrderRecurse(Right(Walker));
      end;
  end;
  {------}
  function TraverseInOrderRecurse(Walker : TTreeCursor) : TTreeCursor;
  begin
    Result := 0;
    if not IsLeaf(Walker) then begin
      Result := TraverseInOrderRecurse(Left(Walker));
      if (Result = 0) then
        if not Action(Self, Examine(Walker), ExtraData) then
          Result := Walker
        else
          Result := TraverseInOrderRecurse(Right(Walker));
    end;
  end;
  {------}
  function TraversePostOrderRecurse(Walker : TTreeCursor) : TTreeCursor;
  begin
    Result := 0;
    if not IsLeaf(Walker) then begin
      Result := TraversePostOrderRecurse(Left(Walker));
      if (Result = 0) then begin
        Result := TraversePostOrderRecurse(Right(Walker));
        if (Result = 0) then
          if not Action(Self, Examine(Walker), ExtraData) then
            Result := Walker;
      end;
    end;
  end;
  {------}
  function TraversePreOrderRevRecurse(Walker : TTreeCursor) : TTreeCursor;
  begin
    Result := 0;
    if not IsLeaf(Walker) then
      if not Action(Self, Examine(Walker), ExtraData) then
        Result := Walker
      else begin
        Result := TraversePreOrderRevRecurse(Right(Walker));
        if (Result = 0) then
          Result := TraversePreOrderRevRecurse(Left(Walker));
      end;
  end;
  {------}
  function TraverseInOrderRevRecurse(Walker : TTreeCursor) : TTreeCursor;
  begin
    Result := 0;
    if not IsLeaf(Walker) then begin
      Result := TraverseInOrderRevRecurse(Right(Walker));
      if (Result = 0) then
        if not Action(Self, Examine(Walker), ExtraData) then
          Result := Walker
        else
          Result := TraverseInOrderRevRecurse(Left(Walker));
    end;
  end;
  {------}
  function TraversePostOrderRevRecurse(Walker : TTreeCursor) : TTreeCursor;
  begin
    Result := 0;
    if not IsLeaf(Walker) then begin
      Result := TraversePostOrderRevRecurse(Right(Walker));
      if (Result = 0) then begin
        Result := TraversePostOrderRevRecurse(Left(Walker));
        if (Result = 0) then
          if not Action(Self, Examine(Walker), ExtraData) then
            Result := Walker;
      end;
    end;
  end;
  {------}
  function TraversePreOrderNoRecurse : TTreeCursor;
  var
    Walker   : PNode;
    Stack    : TStack;
    Finished : boolean;
  begin
    Result := 0;
    Finished := false;
    Stack := TStack.Create(false);
    try
      Stack.Push(btRt^.TLink[cRight]);
      repeat
        Walker := PNode(Stack.Pop);
        if not Action(Self, Walker^.Data, ExtraData) then begin
          Result := Bleach(Walker^.PKC);
          Finished := true;
        end
        else if Backwards then begin
          if (Walker^.TLink[cLeft] <> nil) then
            Stack.Push(Walker^.TLink[cLeft]);
          if (Walker^.TLink[cRight] <> nil) then
            Stack.Push(Walker^.TLink[cRight]);
        end
        else begin
          if (Walker^.TLink[cRight] <> nil) then
            Stack.Push(Walker^.TLink[cRight]);
          if (Walker^.TLink[cLeft] <> nil) then
            Stack.Push(Walker^.TLink[cLeft]);
        end;
      until Finished or Stack.IsEmpty;
    finally
      Stack.Free;
    end;{try..finally}
  end;
  {------}
  function TraverseInOrderNoRecurse : TTreeCursor;
  var
    Walker   : PNode;
    Stack    : TStack;
    Finished : boolean;
  begin
    Result := 0;
    Finished := false;
    Stack := TStack.Create(false);
    try
      Stack.Push(btRt^.TLink[cRight]);
      repeat
        Walker := PNode(Stack.Pop);
        if (Walker = Sentinel) then begin
          Walker := PNode(Stack.Pop);
          if not Action(Self, Walker^.Data, ExtraData) then begin
            Result := Bleach(Walker^.PKC);
            Finished := true;
          end;
        end
        else if Backwards then begin
          if (Walker^.TLink[cLeft] <> nil) then
            Stack.Push(Walker^.TLink[cLeft]);
          Stack.Push(Walker);
          Stack.Push(Sentinel);
          if (Walker^.TLink[cRight] <> nil) then
            Stack.Push(Walker^.TLink[cRight]);
        end
        else begin
          if (Walker^.TLink[cRight] <> nil) then
            Stack.Push(Walker^.TLink[cRight]);
          Stack.Push(Walker);
          Stack.Push(Sentinel);
          if (Walker^.TLink[cLeft] <> nil) then
            Stack.Push(Walker^.TLink[cLeft]);
        end;
      until Finished or Stack.IsEmpty;
    finally
      Stack.Free;
    end;{try..finally}
  end;
  {------}
  function TraversePostOrderNoRecurse : TTreeCursor;
  var
    Walker   : PNode;
    Stack    : TStack;
    Finished : boolean;
  begin
    Result := 0;
    Finished := false;
    Stack := TStack.Create(false);
    try
      Stack.Push(btRt^.TLink[cRight]);
      repeat
        Walker := PNode(Stack.Examine);
        if (Walker = Sentinel) then begin
          Stack.Pop; {the sentinel}
          Walker := PNode(Stack.Pop);
          if not Action(Self, Walker^.Data, ExtraData) then begin
            Result := Bleach(Walker^.PKC);
            Finished := true;
          end;
        end
        else if Backwards then begin
          Stack.Push(Sentinel);
          if (Walker^.TLink[cLeft] <> nil) then
            Stack.Push(Walker^.TLink[cLeft]);
          if (Walker^.TLink[cRight] <> nil) then
            Stack.Push(Walker^.TLink[cRight]);
        end
        else begin
          Stack.Push(Sentinel);
          if (Walker^.TLink[cRight] <> nil) then
            Stack.Push(Walker^.TLink[cRight]);
          if (Walker^.TLink[cLeft] <> nil) then
            Stack.Push(Walker^.TLink[cLeft]);
        end;
      until Finished or Stack.IsEmpty;
    finally
      Stack.Free;
    end;{try..finally}
  end;
  {------}
begin
  if IsEmpty then
    Result := 0
  else if (btTravType = ttLevelOrder) then
    Result := TraverseLevelOrder
  else {non-empty & pre-, in- or post-order traversal} begin
    if UseRecursion then begin
      if Backwards then
        case btTravType of
          ttPreOrder   : Result := TraversePreOrderRevRecurse(Root);
          ttInOrder    : Result := TraverseInOrderRevRecurse(Root);
          ttPostOrder  : Result := TraversePostOrderRevRecurse(Root);
        else
          Result := 0;
          RaiseError(escBadCaseSwitch);
        end {case}
      else
        case btTravType of
          ttPreOrder   : Result := TraversePreOrderRecurse(Root);
          ttInOrder    : Result := TraverseInOrderRecurse(Root);
          ttPostOrder  : Result := TraversePostOrderRecurse(Root);
        else
          Result := 0;
          RaiseError(escBadCaseSwitch);
        end;{case}
    end
    else {no recursion} begin
      case btTravType of
        ttPreOrder   : Result := TraversePreOrderNoRecurse;
        ttInOrder    : Result := TraverseInOrderNoRecurse;
        ttPostOrder  : Result := TraversePostOrderNoRecurse;
      else
        Result := 0;
        RaiseError(escBadCaseSwitch);
      end;{case}
    end;
  end;
end;
{--------}
procedure TBinTree.Join(Cursor : TTreeCursor; Tree : TBinTree);
var
  RootNode : PNode;
begin
  if not IsLeaf(Cursor) then
    RaiseError(escInsInvalidHere);
  if Assigned(Tree) then begin
    if not Tree.IsEmpty then begin
      RootNode := GetNode(Tree.Root);
      RootNode^.PKC := Cursor;
      Dad(Cursor)^.TLink[Kid(Cursor)] := RootNode;
      inc(acCount, Tree.Count);
      {patch up Tree}
      with Tree do begin
        btRt^.TLink[CRight] := nil;
        acCount := 0;
      end;
    end;
    Tree.Free;
  end;
end;
{--------}
function TBinTree.Left(Cursor : TTreeCursor) : TTreeCursor;
begin
  if IsLeaf(Cursor) then
    RaiseError(escCannotMoveHere);
  Result := Csr(GetNode(Cursor), CLeft);
end;
{--------}
function TBinTree.Parent(Cursor : TTreeCursor) : TTreeCursor;
begin
  if IsRoot(Cursor) then
    RaiseError(escCannotMoveHere);
  Result := Bleach(Dad(Cursor)^.PKC);
end;
{--------}
function TBinTree.Replace(Cursor : TTreeCursor; aData : pointer) : pointer;
begin
  {$IFDEF DEBUG}
  EZAssert(not IsLeaf(Cursor), ascExamineLeaf);
  {$ENDIF}
  with GetNode(Cursor)^ do begin
     Result := Data;
     Data := aData;
   end;
end;
{--------}
function TBinTree.Right(Cursor : TTreeCursor) : TTreeCursor;
begin
  if IsLeaf(Cursor) then
    RaiseError(escCannotMoveHere);
  Result := Csr(GetNode(Cursor), CRight);
end;
{--------}
function TBinTree.Root : TTreeCursor;
begin
  Result := Csr(btRt, CRight);
end;
{--------}
function TBinTree.Search(var Cursor : TTreeCursor; aData : pointer) : boolean;
  {------}
  function RecursePreOrder(Walker : TTreeCursor) : boolean;
  begin
    if IsLeaf(Walker) then
      RecursePreOrder := false
    else if (Compare(Examine(Walker), aData) = 0) then begin
      RecursePreOrder := true;
      Cursor := Walker;
    end
    else if RecursePreOrder(Left(Walker)) then
      RecursePreOrder := true
    else
      RecursePreOrder := RecursePreOrder(Right(Walker));
  end;
  {------}
var
  Walker: PNode;
  Stack : TStack;
  FoundIt : boolean;
begin
  if UseRecursion then begin
    Result := RecursePreOrder(Root);
  end
  else {no recursion} begin
    FoundIt := false;
    Stack := TStack.Create(false);
    try
      Stack.Push(btRt^.TLink[cRight]);
      repeat
        Walker := PNode(Stack.Pop);
        if (Compare(Walker^.Data, aData) = 0) then begin
          FoundIt := true;
          Cursor := Bleach(Walker^.PKC);
        end
        else begin
          if (Walker^.TLink[cRight] <> nil) then
            Stack.Push(Walker^.TLink[cRight]);
          if (Walker^.TLink[cLeft] <> nil) then
            Stack.Push(Walker^.TLink[cLeft]);
        end;
      until FoundIt or Stack.IsEmpty;
    finally
      Stack.Free;
    end;{try..finally}
    Result := FoundIt;
  end;
end;
{====================================================================}


{-An iterator for cloning a binary search tree}
function BSTreeCloneData(C : TAbstractContainer;
                         aData : pointer;
                         ExtraData : pointer) : boolean; far;
var
  NewTree : TBinTree absolute ExtraData;
  DummyCursor : TTreeCursor;
  NewData : pointer;
begin
  Result := true;
  with NewTree do begin
    if IsDataOwner then
      NewData := DupData(aData)
    else
      NewData := aData;
    try
      Insert(DummyCursor, NewData);
    except
      if IsDataOwner and Assigned(NewData) then
        DisposeData(NewData);
      raise;
    end;{try..except}
  end;
end;

{-An iterator for joining a binary search tree}
function BSTreeJoinData(C : TAbstractContainer;
                        aData : pointer;
                        ExtraData : pointer) : boolean; far;
var
  OurTree : TBinSearchTree absolute ExtraData;
  DummyCursor : TTreeCursor;
begin
  Result := true;
  OurTree.Insert(DummyCursor, aData);
end;


{===TBinSearchTree====================================================
A binary search tree

A sorted binary tree where for any given data object, all data objects
in its left subtree are less than it, and all data objects in the
right subtree are greater than it. This ordering relies on the Compare
method to be overridden.
=====================================================================}
constructor TBinSearchTree.Create(DataOwner : boolean);
begin
  inherited Create(DataOwner);
  acIsSorted := true;
end;
{--------}
constructor TBinSearchTree.Clone(Source : TAbstractContainer;
                                 DataOwner : boolean;
                                 NewCompare : TCompareFunc);
var
  OldTree : TBinSearchTree absolute Source;
  SaveTravType : TTraversalType;
begin
  Create(DataOwner);
  Compare := NewCompare;
  DupData := OldTree.DupData;
  DisposeData := OldTree.DisposeData;

  if not (Source is TBinTree) then
    RaiseError(escBadSource);

  if OldTree.IsEmpty then Exit;

  SaveTravType := OldTree.TraversalType;
  OldTree.TraversalType := ttPostOrder;
  try
    OldTree.Iterate(BSTreeCloneData, false, Self);
  finally
    OldTree.TraversalType := SaveTravType;