end;

end;

{нам требуется наличие черного братского узла, поэтому если в настоящий момент братский узел окрашен в красный цвет, окрасить родительский узел в красный цвет, братский узел в черный цвет и повысить ранг братского узла; затем снова повторить цикл}

if (Brother^.btColor = rbRed) then begin

Dad^.btColor := rbRed;

Brother^.btColor :=rbBlack;

rbtPromote(Brother);

IsBalanced := false;

end

{ в противном случае братский узел является черным}

else begin

{получить узлы-племянники, помеченные как дальний и ближний}

if (ChildType = ctLeft) then begin

FarNephew := Brother^.btChild[ctRight];

NearNephew := Brother^.btChild[ctLeft];

end

else begin

FarNephew := Brother^.btChild[ctLeft];

NearNephew := Brother^.btChild[ctRight];

end;

{если дальний узел-племянник является красным (обратите внимание, что он может быть нулевым), окрасить его в черный цвет, братский узел в цвет родительского узла, а родительский узел в красный цвет, а затем повысить ранг братского узла; задача выполнена}

if IsRed( FarNephew) then begin

FarNephew^.btColor :=rbBlack;

Brother^.btColor := Dad^.btColor;

Dad^.btColor :=rbBlack;

rbtPromote(Brother);

end

{в противном случае дальний узел-племянник является черным}

else begin

{если ближний узел-племянник является красным (обратите внимание, что он может быть нулевым), окрасить его в цвет родительского узла, родительский узел в черный цвет и повысить ранг узла-племянника посредством спаренного двустороннего поворота; в этом случае задача выполнена}

if isRed(NearNephew) then begin

NearNephew^.btColor := Dad^.btColor;

Dad^.btColor :=rbBlack;

rbtPromote(rbtPromote(NearNephew));

end

{в противном случае ближний узел-племянник является также черным}

else begin

{если родительский узел красный, окрасить его в черный цвет, а братский узел в красный, в результате чего задача будет выполнена}

if (Dad^.btColor = rbRed) then begin

Dad^.btColor :=rbBlack;

Brother^.btColor := rbRed;

end

{в противном случае родительский узел красный: окрасить братский узел в красный цвет и начать балансировку с родительского узла}

else begin

Brother^.btColor := rbRed;

Node := Dad;

IsBalanced := false;

end;

end;

end;

end;

end;

until IsBalanced;

end;

За исключением перекрытых методов Insert и Delete, класс TtdRedBlackTree не представляет особого интереса. Код интерфейса и дополнительного внутреннего метода, выполняющего повышение ранга узла, приведен в листинге 8.26.

Листинг 8.26. Класс TtdRedBlack и метод повышения ранга узла

type

TtdRedBlackTree = class(TtdBinarySearchTree) private protected

function rbtPromote(aNode : PtdBinTreeNode): PtdBinTreeNode;

public

procedure Delete(aItem : pointer); override;

procedure Insert(aItem : pointer); override;

end;

function TtdRedBlackTree.rbtPromote(aNode : PtdBinTreeNode): PtdBinTreeNode;

var

Parent : PtdBinTreeNode;

begin

{пометить родительский узел узла, ранг которого повышается}

Parent := aNode^.btParent;

{в обоих случаях существует 6 связей, которые необходимо разорвать и перестроить: связь узла с его дочерним узлом и противоположная связь; связь узла с его родительским узлом и противоположная связь; и связь родительского узла с его родительским узлом и противоположная связь; обратите внимание, что дочерний узел данного узла может быть нулевым}

{повысить ранг левого дочернего узла, т.е. выполнить поворот родительского узла вправо}

if (Parent^.btChild[ctLeft] = aNode) then begin

Parent^.btChild[ctLeft] := aNode^.btChild[ctRight];

if (Parent^.btChild[ctLeft]<> nil) then

Parent^.btChild[ctLeft]^.btParent := Parent;

aNode^.btParent := Parent^.btParent;

if (aNode^.btParent^.btChild[ctLeft] = Parent) then

aNode^.btParent^.btChild[ctLeft] := anode

else

aNode^.btParent^.btChild[ctRight J := aNode;

aNode^.btChild[ctRight] := Parent;

Parent^.btParent := aNode;