_rb_tree.inc_pas

Delphi Generic Algorytms library - Maps, Lists, Hashmaps, Datastructures.

(*
 * Copyright (c) 2004
 * [e-mail]
 *
 * This material is provided "as is", with absolutely no warranty expressed
 * or implied. Any use is at your own risk.
 *
 * Permission to use or copy this software for any purpose is hereby granted
 * without fee, provided the above notices are retained on all copies.
 * Permission to modify the code and to distribute modified code is granted,
 * provided the above notices are retained, and a notice that the code was
 * modified is included with the above copyright notice.
 *
 *)

{*_TRB_Tree 的旋转和平衡算法借鉴了SGI的算法实现
 *
 * Copyright (c) 1996,1997
 * Silicon Graphics Computer Systems, Inc.
 *
 * Permission to use, copy, modify, distribute and sell this software
 * and its documentation for any purpose is hereby granted without fee,
 * provided that the above copyright notice appear in all copies and
 * that both that copyright notice and this permission notice appear
 * in supporting documentation.  Silicon Graphics makes no
 * representations about the suitability of this software for any
 * purpose.  It is provided "as is" without express or implied warranty.
 *
 *
 * Copyright (c) 1994
 * Hewlett-Packard Company
 *
 * Permission to use, copy, modify, distribute and sell this software
 * and its documentation for any purpose is hereby granted without fee,
 * provided that the above copyright notice appear in all copies and
 * that both that copyright notice and this permission notice appear
 * in supporting documentation.  Hewlett-Packard Company makes no
 * representations about the suitability of this software for any
 * purpose.  It is provided "as is" without express or implied warranty.
 *
 *
 *}

//------------------------------------------------------------------------------
// _RB_Tree的实现
// Create by HouSisong, 2006.10.20
//------------------------------------------------------------------------------

//_RB_Tree.inc_pas ; _RB_Tree.inc_h

{$ifndef __RB_Tree_inc_pas_}
{$define __RB_Tree_inc_pas_}


function _RB_Tree_Minimum(const PNode:_PRB_TreeNode):_PRB_TreeNode;
begin
  result:=PNode;
  while (result.Left<>nil) do
    result:=result.Left;
end;

function _RB_Tree_Maximum(const PNode:_PRB_TreeNode):_PRB_TreeNode;
begin
  result:=PNode;
  while (result.Right<>nil) do
    result:=result.Right;
end;

procedure _RB_Tree_ReBalance(pNodeNew:_PRB_TreeNode;var pNodeRoot:_PRB_TreeNode);
var
  tmpPNode : _PRB_TreeNode;
begin
  pNodeNew.Color:=_rbRed;
  while (pNodeNew<>pNodeRoot) and (pNodeNew.Parent.Color=_rbRed) do
  begin
    if (pNodeNew.Parent=pNodeNew.Parent.Parent.Left) then
    begin
      tmpPNode:=pNodeNew.Parent.Parent.Right;
      if (tmpPNode<>nil) and (tmpPNode.Color=_rbRed) then
      begin
        pNodeNew.Parent.Color:=_rbBlack;
        tmpPNode.Color:=_rbBlack;
        pNodeNew.Parent.Parent.Color:=_rbRed;
        pNodeNew:=pNodeNew.Parent.Parent;
      end
      else
      begin
        if (pNodeNew=pNodeNew.Parent.Right) then
        begin
          pNodeNew:=pNodeNew.Parent;
          _RB_Tree_Rotate_Left(pNodeNew,pNodeRoot);
        end;
        pNodeNew.Parent.Color:=_rbBlack;
        pNodeNew.Parent.Parent.Color:=_rbRed;
        _RB_Tree_Rotate_Right(pNodeNew.Parent.Parent,pNodeRoot);
      end;
    end
    else
    begin
      tmpPNode:=pNodeNew.Parent.Parent.Left;

      if (tmpPNode<>nil) and (tmpPNode.Color=_rbRed) then
      begin
        pNodeNew.Parent.Color:=_rbBlack;
        tmpPNode.Color:=_rbBlack;
        pNodeNew.Parent.Parent.Color:=_rbRed;
        pNodeNew:=pNodeNew.Parent.Parent;
      end
      else
      begin
        if (pNodeNew=pNodeNew.Parent.Left) then
        begin
          pNodeNew:=pNodeNew.Parent;
          _RB_Tree_Rotate_Right(pNodeNew,pNodeRoot);
        end;
        pNodeNew.Parent.Color:=_rbBlack;
        pNodeNew.Parent.Parent.Color:=_rbRed;
        _RB_Tree_Rotate_Left(pNodeNew.Parent.Parent,pNodeRoot);
      end;
    end;
  end;
  pNodeRoot.Color:=_rbBlack;
end;

procedure _RB_Tree_Rotate_Left(pNode:_PRB_TreeNode;var pNodeRoot:_PRB_TreeNode);
var
  tmpPNode : _PRB_TreeNode;
begin
  tmpPNode:= pNode.Right;
  pNode.Right:=tmpPNode.Left;
  if (tmpPNode.Left<>nil) then
    tmpPNode.Left.Parent:=pNode;
  tmpPNode.Parent:=pNode.Parent;

  if (pNode=pNodeRoot)  then
    pNodeRoot:=tmpPNode
  else if (pNode=pnode.Parent.Left) then
    pNode.Parent.Left:=tmpPNode
  else
    pNode.Parent.Right:=tmpPNode;
  tmpPNode.Left:=pNode;
  pNode.Parent:=tmpPNode;
end;

procedure _RB_Tree_Rotate_Right(pNode:_PRB_TreeNode;var pNodeRoot:_PRB_TreeNode);
var
  tmpPNode : _PRB_TreeNode;
begin
  tmpPNode:= pNode.Left;
  pNode.Left:=tmpPNode.Right;
  if (tmpPNode.Right<>nil) then
    tmpPNode.Right.Parent:=pNode;
  tmpPNode.Parent:=pNode.Parent;

  if (pNode=pNodeRoot)  then
    pNodeRoot:=tmpPNode
  else if (pNode=pnode.Parent.Right) then
    pNode.Parent.Right:=tmpPNode
  else
    pNode.Parent.Left:=tmpPNode;
  tmpPNode.Right:=pNode;
  pNode.Parent:=tmpPNode;
end;

function  _Rb_Tree_Rebalance_For_Erase(ePosNode:_PRB_TreeNode;var TreeRoot,MostLeftNode,MostRightNode:_PRB_TreeNode):_PRB_TreeNode;
var
  tRBNode,DelTagRBNode,tRBNode_parent : _PRB_TreeNode;
  tmpColor : _TRB_TreeColorType;
  RtRBNode : _PRB_TreeNode;
begin
  DelTagRBNode := ePosNode;
  //tRBNode := nil;
  //tRBNode_parent := nil;
  if (DelTagRBNode.left = nil) then     // ePosNode has at most one non-null child. y = z.
    tRBNode := DelTagRBNode.right     // tRBNode might be null.
  else
  begin
    if (DelTagRBNode.right = nil) then  // ePosNode has exactly one non-null child. y = z.
      tRBNode := DelTagRBNode.left    // tRBNode is not null.
    else
    begin                    // ePosNode has two non-null children.  Set DelTagRBNode to
      DelTagRBNode := DelTagRBNode.right;   //   ePosNode's successor.  tRBNode might be null.
      while (DelTagRBNode.left <> nil) do
        DelTagRBNode := DelTagRBNode.left;
      tRBNode := DelTagRBNode.right;
    end;
  end;
  if (DelTagRBNode <> ePosNode) then
  begin           // relink y in place of z.  y is z's successor
    ePosNode.left.parent := DelTagRBNode;
    DelTagRBNode.left := ePosNode.left;
    if (DelTagRBNode <> ePosNode.right) then
    begin
      tRBNode_parent := DelTagRBNode.parent;
      if (tRBNode<>nil) then tRBNode.parent := DelTagRBNode.parent;
      DelTagRBNode.parent.left := tRBNode;      // DelTagRBNode must be a child of left
      DelTagRBNode.right := ePosNode.right;
      ePosNode.right.parent := DelTagRBNode;
    end
    else
      tRBNode_parent := DelTagRBNode;
    if (TreeRoot = ePosNode) then
      TreeRoot := DelTagRBNode
    else if (ePosNode.parent.left = ePosNode) then
      ePosNode.parent.left := DelTagRBNode
    else
      ePosNode.parent.right := DelTagRBNode;
    DelTagRBNode.parent := ePosNode.parent;
    tmpColor:=DelTagRBNode.color;
    DelTagRBNode.color:=ePosNode.color;
    ePosNode.color:=tmpColor;
    DelTagRBNode := ePosNode;
    // DelTagRBNode now points to node to be actually deleted
  end
  else
  begin                         // DelTagRBNode = ePosNode
    tRBNode_parent := DelTagRBNode.parent;
    if (tRBNode<>nil) then  tRBNode.parent := DelTagRBNode.parent;
    if (TreeRoot = ePosNode) then
      TreeRoot := tRBNode
    else
    begin
      if (ePosNode.parent.left = ePosNode) then
        ePosNode.parent.left := tRBNode
      else
        ePosNode.parent.right := tRBNode;
    end;
    if (MostLeftNode = ePosNode) then
      if (ePosNode.right = nil) then        // ePosNode.left must be null also
        MostLeftNode := ePosNode.parent
    // makes MostLeftNode = header if ePosNode = TreeRoot
      else
        MostLeftNode :=  _RB_Tree_Minimum(tRBNode);
    if (MostRightNode = ePosNode) then
    begin
      if (ePosNode.left = nil) then         // ePosNode.right must be null also
        MostRightNode := ePosNode.parent
    // makes MostRightNode = header if ePosNode = TreeRoot
      else                      // tRBNode = ePosNode.left
        MostRightNode := _RB_Tree_Maximum(tRBNode);
    end;
  end;
  if (DelTagRBNode.color <> _rbRed) then
  begin
    while ((tRBNode <> TreeRoot)  and  ((tRBNode = nil)  or  (tRBNode.color = _rbBlack))) do
    begin
      if (tRBNode = tRBNode_parent.left) then
       begin
        RtRBNode := tRBNode_parent.right;
        if (RtRBNode.color = _rbRed) then
        begin
          RtRBNode.color := _rbblack;
          tRBNode_parent.color := _rbred;
          _Rb_tree_rotate_left(tRBNode_parent, TreeRoot);
          RtRBNode := tRBNode_parent.right;
        end;
        if (((RtRBNode.left = nil)  or
             (RtRBNode.left.color = _rbblack))  and
            ((RtRBNode.right = nil)  or
             (RtRBNode.right.color = _rbblack)))then
        begin
          RtRBNode.color := _rbred;
          tRBNode := tRBNode_parent;
          tRBNode_parent := tRBNode_parent.parent;
        end
        else
        begin
          if ((RtRBNode.right = nil)  or
              (RtRBNode.right.color = _rbblack)) then
          begin
            if (RtRBNode.left<>nil) then RtRBNode.left.color := _rbblack;
            RtRBNode.color := _rbred;
            _Rb_tree_rotate_right(RtRBNode, TreeRoot);
            RtRBNode := tRBNode_parent.right;
          end;
          RtRBNode.color := tRBNode_parent.color;
          tRBNode_parent.color := _rbblack;
          if (RtRBNode.right<>nil) then RtRBNode.right.color := _rbblack;
          _Rb_tree_rotate_left(tRBNode_parent, TreeRoot);
          break;
        end;
      end
      else
      begin                   // same as above, with right <. left.
        RtRBNode := tRBNode_parent.left;
        if (RtRBNode.color = _rbred) then
        begin
          RtRBNode.color := _rbblack;
          tRBNode_parent.color := _rbred;
          _Rb_tree_rotate_right(tRBNode_parent, TreeRoot);
          RtRBNode := tRBNode_parent.left;
        end;
        if (((RtRBNode.right = nil)  or
             (RtRBNode.right.color = _rbblack))  and
            ((RtRBNode.left = nil)  or
             (RtRBNode.left.color = _rbblack))) then
        begin
          RtRBNode.color := _rbred;
          tRBNode := tRBNode_parent;
          tRBNode_parent := tRBNode_parent.parent;
        end
        else
        begin
          if ((RtRBNode.left = nil)  or
              (RtRBNode.left.color = _rbblack)) then
          begin
            if (RtRBNode.right<>nil) then RtRBNode.right.color := _rbblack;
            RtRBNode.color := _rbred;
            _Rb_tree_rotate_left(RtRBNode, TreeRoot);
            RtRBNode := tRBNode_parent.left;
          end;
          RtRBNode.color := tRBNode_parent.color;
          tRBNode_parent.color := _rbblack;
          if (RtRBNode.left<>nil) then RtRBNode.left.color := _rbblack;
          _Rb_tree_rotate_right(tRBNode_parent, TreeRoot);
          break;
        end;
      end;
    end;
    if (tRBNode<>nil) then tRBNode.color := _rbblack;
  end;
  result:=DelTagRBNode;
end;


procedure _TRB_TreeIt_Next(var it:_TRB_TreeIterator);
var
  tmpNode,itTmpNode : _PRB_TreeNode;
begin
  if (it.node.Right<>nil) then
  begin
    tmpNode:=it.node.Right;
    while (tmpNode.Left<>nil) do
      tmpNode:=tmpNode.Left;
    it.Node:=tmpNode;
  end
  else
  begin
    itTmpNode:=it.node;
    tmpNode :=itTmpNode.Parent;
    while (itTmpNode=tmpNode.Right) do
    begin
      itTmpNode:=tmpNode;
      tmpNode:=tmpNode.Parent;
    end;
    if (itTmpNode.Right<>tmpNode) then
      it.Node:=tmpNode
    else
      it.Node:=itTmpNode;
  end;
end;

procedure _TRB_TreeIt_Previous(var it:_TRB_TreeIterator);
var
  tmpNode : _PRB_TreeNode;
begin
  if ( (it.node.Color=_rbRed) and (it.node.Parent.Parent=it.node) ) then
    it.node:=it.node.Right
  else if (it.node.Left<>nil) then
  begin
    tmpNode:=it.node.Left;
    while (tmpNode.Right<>nil) do
      tmpNode:=tmpNode.Right;
    it.node:=tmpNode;
  end
  else
  begin
    tmpNode :=it.node.Parent;
    while (it.node=tmpNode.Left) do
    begin
      it.node:=tmpNode;
      tmpNode:=tmpNode.Parent;
    end;
    it.node:=tmpNode;
  end;
end;

{ _TRB_Tree }

function _TRB_Tree.getNewNode(const Key: _RB_Tree_KeyType): _PRB_TreeNode;
begin
  //result:=nil;
  if F_DGL_OnlySet then
    system.New(_PRB_TreeNode_OnlySet(result))
  else
    system.New(result);

  try
    {$ifdef _DGL_ObjValue_Key}
      result.Key:=_CopyCreateNew_Key(Key);
    {$else}
      result.Key:=Key;
    {$endif}
    result.Parent:=nil;
    result.Left:=nil;
    result.Right:=nil;
    result.Color:=_rbRed;
  except
    self.DisposeNode(result);
    raise;
  end;
end;

function _TRB_Tree.getNewNode(const Key: _RB_Tree_KeyType;const Value: _RB_Tree_ValueType): _PRB_TreeNode;
begin
  result:= getNewNode(Key);
  try
    if (not F_DGL_OnlySet) then
    begin
      {$ifdef _DGL_ObjValue_Value}
        result.Value:=_CopyCreateNew_Value(Value);
      {$else}
        result.Value:=Value;
      {$endif}
    end;
  except
    self.DisposeNode(result);
    raise;
  end;
end;

procedure _TRB_Tree.DisposeNode(PNode: _PRB_TreeNode);
begin
  {$ifdef _DGL_ObjValue_Key}
  _Free_Key(PNode.Key);
  {$endif}
  {$ifdef _DGL_ObjValue_Value}
    if not F_DGL_OnlySet then
      _Free_Value(PNode.Value);
  {$endif}

  if F_DGL_OnlySet then
    system.Dispose(_PRB_TreeNode_OnlySet(PNode))
  else
    system.Dispose(PNode);
end;

procedure _TRB_Tree.Inti;
begin
  if (FHeader=nil) then
    system.new(FHeader);
  FHeader.Color:=_rbRed;
  FHeader.Parent:=nil;
  FHeader.Left:=_PRB_TreeNode(FHeader);
  FHeader.Right:=_PRB_TreeNode(FHeader);
  self.FNodeCount:=0;
end;

constructor _TRB_Tree.Create(const IsOnlySet: boolean);
begin
  inherited Create();
  self.F_DGL_OnlySet:=IsOnlySet;