Chapter #13 Examples in Oz
% Utility functions
proc {While Expr Stmt}
if {Expr} then {Stmt} {While Expr Stmt} end
end
fun {TreeColor tree(color:Color ...)} Color end
fun {TreeKey tree(key:Key ...)} Key end
fun {TreeParent tree(parent:Parent ...)} Parent end
fun {TreeLeft tree(left:Left ...)} Left end
fun {TreeRight tree(right:Right ...)} Right end
fun {TreeData tree(data:Data ...)} Data end
fun {TreeRoot T}
case T
of tree(parent:Parent ...) then
if @Parent == nil then
T
else
{TreeRoot @Parent}
end
else nil
end
end
fun {TreeDepth X}
if @{TreeParent X} == nil then
0
else
1 + {TreeDepth @{TreeParent X}}
end
end
% From chapter 12
proc {InOrderTreeWalk X}
case X
of tree(key:Key left:Left right:Right ...) then
{InOrderTreeWalk @Left}
{Browse 'InOrderTreeWalk'#@Key#(if @{TreeParent X} \= nil then @{TreeKey @{TreeParent X}} else ' ' end)#@{TreeColor X}#{TreeDepth X}}
{InOrderTreeWalk @Right}
[] nil then skip
end
end
fun {TreeSearch X K}
case X
of nil then X
[] tree(key:Key left:Left right:Right ...) then
if K == @Key then
X
else
if K < @Key then
{TreeSearch @Left K}
else
{TreeSearch @Right K}
end
end
end
end
fun {TreeMinimum X}
case X
of nil then nil
[] tree(left:Left ...) then
if @Left \= nil then
{TreeMinimum @Left}
else
X
end
end
end
fun {TreeMaximum X}
case X
of nil then nil
[] tree(right:Right ...) then
if @Right \= nil then
{TreeMaximum @Right}
else
X
end
end
end
fun {TreeSuccessor X}
fun {ParentSuccessor X Y}
case Y
of tree(right:Right ...) then
if X == @Right then
{ParentSuccessor @Right X}
else
Y
end
[] nil then nil
end
end
in
case X
of tree(right:Right parent:Parent ...) then
if @Right \= nil then
{TreeMinimum @Right}
else
{ParentSuccessor X @Parent}
end
else nil
end
end
fun {TreePredecessor X}
fun {ParentPredecessor X Y}
case Y
of tree(left:Left ...) then
if X == @Left then
{ParentPredecessor @Left X}
else
Y
end
[] nil then nil
end
end
in
case X
of tree(left:Left parent:Parent ...) then
if @Left \= nil then
{TreeMaximum @Left}
else
{ParentPredecessor X @Parent}
end
else nil
end
end
% 13.2 LeftRotate
proc {LeftRotate T X}
Y = @{TreeRight X}
in
{TreeRight X} := @{TreeLeft Y}
if @{TreeLeft Y} \= nil then
{TreeParent @{TreeLeft Y}} := X
end
{TreeParent Y} := @{TreeParent X}
if @{TreeParent X} \= nil then
if X == @{TreeLeft @{TreeParent X}} then
{TreeLeft @{TreeParent X}} := Y
else
{TreeRight @{TreeParent X}} := Y
end
else
{Browse resetRoot#@{TreeKey Y}}
%Root = Y
end
{TreeLeft Y} := X
{TreeParent X} := Y
end
% 13.2 RightRotate
proc {RightRotate T X}
Y = @{TreeLeft X}
in
{TreeLeft X} := @{TreeRight Y}
if @{TreeRight Y} \= nil then
{TreeParent @{TreeRight Y}} := X
end
{TreeParent Y} := @{TreeParent X}
if @{TreeParent X} \= nil then
if X == @{TreeRight @{TreeParent X}} then
{TreeRight @{TreeParent X}} := Y
else
{TreeLeft @{TreeParent X}} := Y
end
else
{Browse resetRoot#@{TreeKey Y}}
%Root = Y
end
{TreeRight Y} := X
{TreeParent X} := Y
end
% 13.3 RBInsert
fun {RBInsert T Z}
Y = {NewCell nil}
X = {NewCell {TreeRoot T}}
in
{While
fun {$} @X \= nil end
proc {$}
Y := @X
if @{TreeKey Z} < @{TreeKey @X} then
X := @{TreeLeft @X}
else
X := @{TreeRight @X}
end
end}
{TreeParent Z} := @Y
if @Y \= nil then
if @{TreeKey Z} < @{TreeKey @Y} then
{TreeLeft @Y} := Z
else
{TreeRight @Y} := Z
end
else
{Browse resetRoot#@{TreeKey Z}}
%Root = Z
end
{TreeLeft Z} := nil
{TreeRight Z} := nil
{TreeColor Z} := red
{RBInsertFixup T Z}
{TreeRoot Z}
end
% 13.3 RBInsertFixup
proc {RBInsertFixup T Zs}
Z = {NewCell Zs}
in
{While
fun {$} @{TreeParent @Z} \= nil andthen @{TreeColor @{TreeParent @Z}} == red end
proc {$}
if @{TreeParent @Z} == @{TreeLeft @{TreeParent @{TreeParent @Z}}} then
local
Y = @{TreeRight @{TreeParent @{TreeParent @Z}}}
in
if Y \= nil andthen @{TreeColor Y} == red then
{TreeColor @{TreeParent @Z}} := black
{TreeColor Y} := black
{TreeColor @{TreeParent @{TreeParent @Z}}} := red
Z := @{TreeParent @{TreeParent @Z}}
else
if @Z == @{TreeRight @{TreeParent @Z}} then
Z := @{TreeParent @Z}
{LeftRotate T @Z}
end
{TreeColor @{TreeParent @Z}} := black
{TreeColor @{TreeParent @{TreeParent @Z}}} := red
{RightRotate T @{TreeParent @{TreeParent @Z}}}
end
end
else
local
Y = @{TreeLeft @{TreeParent @{TreeParent @Z}}}
in
if Y \= nil andthen @{TreeColor Y} == red then
{TreeColor @{TreeParent @Z}} := black
{TreeColor Y} := black
{TreeColor @{TreeParent @{TreeParent @Z}}} := red
Z := @{TreeParent @{TreeParent @Z}}
else
if @Z == @{TreeLeft @{TreeParent @Z}} then
Z := @{TreeParent @Z}
{RightRotate T @Z}
end
{TreeColor @{TreeParent @Z}} := black
{TreeColor @{TreeParent @{TreeParent @Z}}} := red
{LeftRotate T @{TreeParent @{TreeParent @Z}}}
end
end
end
end}
{TreeColor {TreeRoot @Z}} := black
end
% 13.4 RBDelete
fun {RBDelete T Z}
Y = {NewCell nil}
X = {NewCell nil}
in
if @{TreeLeft Z} == nil orelse @{TreeRight Z} == nil then
Y := Z
else
Y := {TreeSuccessor Z}
end
if @{TreeLeft @Y} \= nil then
X := @{TreeLeft @Y}
else
X := @{TreeRight @Y}
end
if @X \= nil then
{TreeParent @X} := @{TreeParent @Y}
end
if @{TreeParent @Y} \= nil then
if @Y == @{TreeLeft @{TreeParent @Y}} then
{TreeLeft @{TreeParent @Y}} := @X
else
{TreeRight @{TreeParent @Y}} := @X
end
%else
%Root = @X
end
if @Y \= Z then
{TreeKey Z} := @{TreeKey @Y}
{TreeData Z} := @{TreeData @Y}
end
if @X \= nil andthen @{TreeColor @Y} == black then
{RBDeleteFixup T @X}
end
local
Root = {TreeRoot @Y}
in
% @X == nil
{Browse xxx#@X#@{TreeKey Root}#@{TreeKey @Y}}
Root
end
end
% 13.4 RBDeleteFixup
proc {RBDeleteFixup T Xs}
X = {NewCell Xs}
Root = {TreeRoot T}
in
{While
fun {$} @{TreeParent @X} \= nil andthen @X \= Root andthen @{TreeColor @X} == black end
proc {$}
if @X == @{TreeLeft @{TreeParent @X}} then
local
W = {NewCell @{TreeRight @{TreeParent @X}}}
in
if @W \= nil then
if @{TreeColor @W} == red then
{TreeColor @W} := black
{TreeColor @{TreeParent @X}} := red
{LeftRotate T @{TreeParent @X}}
W := @{TreeRight @{TreeParent @X}}
end
if @{TreeLeft @W} \= nil andthen
@{TreeRight @W} \= nil andthen
@{TreeColor @{TreeLeft @W}} == black andthen
@{TreeColor @{TreeRight @W}} == black then
{TreeColor @W} := red
X := @{TreeParent @X}
else
if @{TreeRight @W} \= nil andthen
@{TreeLeft @W} \= nil andthen
@{TreeColor @{TreeRight @W}} == black then
{TreeColor @{TreeLeft @W}} := black
{TreeColor @W} := red
{RightRotate T @W}
W := @{TreeRight @{TreeParent @X}}
end
{TreeColor @W} := @{TreeColor @{TreeParent @X}}
{TreeColor @{TreeParent @X}} := black
if @{TreeRight @W} \= nil then
{TreeColor @{TreeRight @W}} := black
end
{LeftRotate T @{TreeParent @X}}
X := Root
end
else
X := Root
end
end
else
local
W = {NewCell @{TreeLeft @{TreeParent @X}}}
in
if @{TreeColor @W} == red then
{TreeColor @W} := black
{TreeColor @{TreeParent @X}} := red
{RightRotate T @{TreeParent @X}}
W := @{TreeLeft @{TreeParent @X}}
end
if @{TreeRight @W} \= nil andthen
@{TreeLeft @W} \= nil andthen
@{TreeColor @{TreeRight @W}} == black andthen
@{TreeColor @{TreeLeft @W}} == black then
{TreeColor @W} := red
X := @{TreeParent @X}
else
if @{TreeLeft @W} \= nil andthen
@{TreeRight @W} \= nil andthen
@{TreeColor @{TreeLeft @W}} == black then
{TreeColor @{TreeRight @W}} := black
{TreeColor @W} := red
{LeftRotate T @W}
W := @{TreeLeft @{TreeParent @X}}
end
{TreeColor @W} := @{TreeColor @{TreeParent @X}}
{TreeColor @{TreeParent @X}} := black
if @{TreeLeft @W} \= nil then
{TreeColor @{TreeLeft @W}} := black
end
{RightRotate T @{TreeParent @X}}
X := Root
end
end
end
end}
{TreeColor @X} := black
end
{Browse 'RBInsert'}
TestTree = {NewCell nil}
TestTree := {RBInsert @TestTree tree(key:{NewCell 26} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell a})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 17} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell b})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 41} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell c})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 14} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell d})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 21} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell e})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 30} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell f})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 47} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 10} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 16} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 19} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 23} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 28} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 38} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 7} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 12} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 15} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 20} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 35} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 39} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
TestTree := {RBInsert @TestTree tree(key:{NewCell 3} color:{NewCell _} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
{InOrderTreeWalk @TestTree}
{Browse 'RBDelete'}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 26}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 17}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 41}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 14}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 21}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 30}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 47}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 10}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 16}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 19}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 23}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 28}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 38}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 7}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 12}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 15}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 20}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 35}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 39}}
TestTree := {RBDelete @TestTree {TreeSearch @TestTree 3}}
{InOrderTreeWalk @TestTree}
|