Chapter #12 Examples in Oz

% Utility functions
proc {While Expr Stmt}
   if {Expr} then {Stmt} {While Expr Stmt} end
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

proc {SetParent X}
   case X
   of tree(left:Left right:Right ...) then
      case @Left
      of tree(parent:Parent ...) then Parent := X
      else skip
      end
      case @Right
      of tree(parent:Parent ...) then Parent := X
      else skip
      end
   else skip
   end
end

TestTree = {NewCell tree(key:{NewCell 20}
                         parent:{NewCell nil}
                         left  :{NewCell tree(key:{NewCell 10}
                                              parent:{NewCell _}
                                              left:{NewCell nil}
                                              right:{NewCell nil}
                                              data:{NewCell a})}
                         right :{NewCell tree(key:{NewCell 30}
                                              parent:{NewCell _}
                                              left:{NewCell nil}
                                              right:{NewCell nil}
                                              data:{NewCell c})}
                         data:{NewCell b})}

{SetParent @TestTree}

% 12.1 InOrderTreeWalk
proc {InOrderTreeWalk X}
   case X
   of tree(key:Key left:Left right:Right ...) then
      {InOrderTreeWalk @Left}
      {Browse 'InOrderTreeWalk'#@Key}
      {InOrderTreeWalk @Right}
   [] nil then skip
   end
end

{InOrderTreeWalk @TestTree}

% 12.2 TreeSearch
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

{Browse 'TreeSearch'#@{TreeData {TreeSearch @TestTree 10}}}

% 12.2 IterativeTreeSearch
fun {IterativeTreeSearch X K}
   Y = {NewCell X}
in
   {While
      fun {$}
         case @Y
         of nil then false
         [] tree(key:Key ...) then K \= @Key
         end
      end
      proc {$}
         case @Y
         of tree(key:Key left:Left right:Right ...) then
            if K < @Key then
               Y := @Left
            else
               Y := @Right
            end
         end
      end}
   @Y
end

{Browse 'TreeSearch'#@{TreeData {IterativeTreeSearch @TestTree 10}}}

% 12.2 TreeMinimum
fun {TreeMinimum X}
   case X
   of nil then nil
   [] tree(left:Left ...) then
      if @Left \= nil then
         {TreeMinimum @Left}
      else
         X
      end
   end
end

{Browse 'TreeMinimum'#@{TreeKey {TreeMinimum @TestTree}}}

% 12.2 TreeMaximum
fun {TreeMaximum X}
   case X
   of nil then nil
   [] tree(right:Right ...) then
      if @Right \= nil then
         {TreeMaximum @Right}
      else
         X
      end
   end
end

{Browse 'TreeMaximum'#@{TreeKey {TreeMaximum @TestTree}}}

% 12.2 TreeSuccessor
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

{Browse 'TreeSuccessor'#@{TreeKey {TreeSuccessor @TestTree}}}

% 12.2 TreePredecessor
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

{Browse 'TreePredecessor'#@{TreeKey {TreePredecessor {TreeSuccessor @TestTree}}}}

% 12.3 TreeInsert
fun {TreeInsert 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 (T \= nil) then
      if @Y == nil then
         {TreeParent {TreeRoot T}} := @Z
      elseif @{TreeKey Z} < @{TreeKey @Y} then
         {TreeLeft @Y} := Z
      else
         {TreeRight @Y} := Z
      end
      {TreeRoot T}
   else
      Z
   end
end

{Browse 'TreeInsert'}
TestTree := {TreeInsert nil       tree(key:{NewCell  5} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell a})}
TestTree := {TreeInsert @TestTree tree(key:{NewCell 10} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell b})}
TestTree := {TreeInsert @TestTree tree(key:{NewCell 15} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell c})}
TestTree := {TreeInsert @TestTree tree(key:{NewCell 20} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell d})}
TestTree := {TreeInsert @TestTree tree(key:{NewCell 25} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell e})}
TestTree := {TreeInsert @TestTree tree(key:{NewCell 30} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell f})}
TestTree := {TreeInsert @TestTree tree(key:{NewCell 35} parent:{NewCell nil} left:{NewCell nil} right:{NewCell nil} data:{NewCell g})}
{InOrderTreeWalk @TestTree}

% 12.3 TreeDelete
fun {TreeDelete T Z}
   X = {NewCell _}
   Y = {NewCell _}
   Root = _
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
      Root = @X
   else
      Root = {TreeRoot @Y}
      if @Y == @{TreeLeft @{TreeParent @Y}} then
         {TreeLeft @{TreeParent @Y}} := @X
      else
         {TreeRight @{TreeParent @Y}} := @X
      end
   end
   if @Y \= Z then
      {TreeKey Z} := @{TreeKey @Y}
      {TreeData Z} := @{TreeData @Y}
   end
   Root
end

{Browse 'TreeDelete'}
TestTree := {TreeDelete @TestTree {TreeSearch @TestTree 5}}
TestTree := {TreeDelete @TestTree {TreeSearch @TestTree 15}}
TestTree := {TreeDelete @TestTree {TreeSearch @TestTree 25}}
TestTree := {TreeDelete @TestTree {TreeSearch @TestTree 35}}
{InOrderTreeWalk @TestTree}