PFDS Chapter #03 Examples in Oz
% Utility functions for tests
proc {HeapTest F}
   A = {F.insert 1 F.empty}
   B = {F.insert 3 A}
   C = {F.insert 7 B}
   D = {F.insert 5 C}
   X = {F.insert 2 F.empty}
   Y = {F.insert 6 X}
   Z = {F.insert 4 Y}
   H = {F.merge D Z}
in
   {Browse D}
   {Browse Z}
   {Browse H}
   {Browse {F.findMin H}}
   {Browse {F.findMin {F.deleteMin H}}}
   {Browse {F.findMin {F.deleteMin {F.deleteMin H}}}}
   {Browse {F.findMin {F.deleteMin {F.deleteMin {F.deleteMin H}}}}}
   {Browse {F.findMin {F.deleteMin {F.deleteMin {F.deleteMin {F.deleteMin H}}}}}}
   {Browse {F.findMin {F.deleteMin {F.deleteMin {F.deleteMin {F.deleteMin {F.deleteMin H}}}}}}}
   {Browse {F.findMin {F.deleteMin {F.deleteMin {F.deleteMin {F.deleteMin {F.deleteMin {F.deleteMin H}}}}}}}}
end

proc {SetTest F}
   A = {F.insert 1 F.empty}
   B = {F.insert 2 A}
   C = {F.insert 4 B}
   D = {F.insert 3 C}
in
   {Browse D}
   {Browse {F.member 3 D}}
   {Browse {F.member 5 D}}
end

% Functions defined in previous chapters
ORDEREDVALUE =
   functor
   export
      eq : EQ
      lt : LT
      leq : LEQ
   define
      fun {EQ X Y} X == Y end
      fun {LT X Y} X < Y end
      fun {LEQ X Y} X =< Y end
   end
[OrderedValue] = {Module.apply [ORDEREDVALUE]}

% 3.1 LeftistHeap
LEFTISTHEAP =
   functor
   export
      initialize : Initialize
      empty      : Empty
      isEmpty    : IsEmpty
      insert     : Insert
      merge      : Merge
      findMin    : FindMin
      deleteMin  : DeleteMin
   define
      Element
      proc {Initialize OrderedSet} Element = OrderedSet end
      Empty = nil
      fun {IsEmpty Heap} Heap == Empty end
      fun {Rank Heap}
         case Heap
         of tree(R _ _ _) then R
         else 0
         end
      end
      fun {MakeT X Heap1 Heap2}
         if {Rank Heap1} >= {Rank Heap2} then
            tree({Rank Heap2}+1 X Heap1 Heap2)
         else
            tree({Rank Heap1}+1 X Heap2 Heap1)
         end
      end
      fun {Merge Heap1 Heap2}
         case Heap1#Heap2
         of _#nil then Heap1
         [] nil#_ then Heap2
         [] tree(_ X A1 B1)#tree(_ Y A2 B2) then
            if {Element.leq X Y} then
               {MakeT X A1 {Merge B1 Heap2}}
            else
               {MakeT Y A2 {Merge Heap1 B2}}
            end
         end
      end
      fun {Insert X Heap}
         {Merge tree(1 X nil nil) Heap}
      end
      fun {FindMin Heap}
         case Heap
         of tree(_ X A B) then X
         else raise empty end
         end
      end
      fun {DeleteMin Heap}
         case Heap
         of tree(_ X A B) then {Merge A B}
         else raise empty end
         end
      end
   end

[LeftistHeap] = {Module.apply [LEFTISTHEAP]}
{LeftistHeap.initialize OrderedValue}

{HeapTest LeftistHeap}

% 3.2 BinomialHeap
BINOMIALHEAP =
   functor
   export
      initialize : Initialize
      empty      : Empty
      isEmpty    : IsEmpty
      insert     : Insert
      merge      : Merge
      findMin    : FindMin
      deleteMin  : DeleteMin
   define
      Element
      proc {Initialize OrderedSet} Element = OrderedSet end
      Empty = nil
      fun {IsEmpty Heap} Heap == Empty end
      fun {Rank Tree=node(R X C)} R end
      fun {Root Tree=node(R X C)} X end
      fun {Link Tree1=node(R X1 C1) Tree2=node(_ X2 C2)}
         if {Element.leq X1 X2} then
            node(R+1 X1 Tree2|C1)
         else
            node(R+1 X2 Tree1|C2)
         end
      end
      fun {InsTree Tree Heap}
         case Heap
         of nil then [Tree]
         [] H|T then
            if {Rank Tree} < {Rank H} then
               Tree|Heap
            else
               {InsTree {Link Tree H} T}
            end
         end
      end
      fun {Insert X Heap}
         {InsTree node(0 X nil) Heap}
      end
      fun {Merge Heap1 Heap2}
         case Heap1#Heap2
         of _#nil then Heap1
         [] nil#_ then Heap2
         [] (H1|T1)#(H2|T2) then
            if {Rank H1} < {Rank H2} then
               H1|{Merge T1 Heap2}
            elseif {Rank H2} < {Rank H1} then
               H2|{Merge Heap1 T2}
            else
               {InsTree {Link H1 H2} {Merge T1 T2}}
            end
         end
      end
      fun {RemoveMinTree Heap}
         case Heap
         of [Tree] then Tree#nil
         [] H|T then
            local
               A#B = {RemoveMinTree T}
            in
               if {Element.leq {Root H} {Root A}} then
                  H#T
               else
                  A#(H|B)
               end
            end
         else raise empty end
         end
      end
      fun {FindMin Heap}
         Tree#_ = {RemoveMinTree Heap}
      in
         {Root Tree}
      end
      fun {DeleteMin Heap}
         node(_ X Ts1)#Ts2 = {RemoveMinTree Heap}
      in
         {Merge {List.reverse Ts1} Ts2}
      end
   end

[BinomialHeap] = {Module.apply [BINOMIALHEAP]}
{BinomialHeap.initialize OrderedValue}

{HeapTest BinomialHeap}

% 3.3 RedBlackSet
REDBLACKSET =
   functor
   export
      initialize : Initialize
      empty      : Empty
      member     : Member
      insert     : Insert
   define
      Element
      proc {Initialize OrderedSet} Element = OrderedSet end
      Empty = nil
      fun {Member X Set}
         case Set
         of tree(_ A Y B) then
            if {Element.lt X Y} then
               {Member X A}
            elseif {Element.lt Y X} then
               {Member X B}
            else
               true
            end
         else false
         end
      end
      fun {Balance Color A X D}
         case Color#A#X#D
         of black#tree(red tree(red A X B) Y C)#Z#D then tree(red tree(black A X B) Y tree(black C Z D))
         [] black#tree(red A X tree(red B Y C))#Z#D then tree(red tree(black A X B) Y tree(black C Z D))
         [] black#A#X#tree(red tree(red B Y C) Z D) then tree(red tree(black A X B) Y tree(black C Z D))
         [] black#A#X#tree(red B Y tree(red C Z D)) then tree(red tree(black A X B) Y tree(black C Z D))
         else tree(Color A X D)
         end
      end
      fun {Insert X Set}
         fun {Ins Set}
            case Set
            of nil then tree(red nil X nil)
            [] tree(Color A Y B) then
               if {Element.lt X Y} then
                  {Balance Color {Ins A} Y B}
               elseif {Element.lt Y X} then
                  {Balance Color A Y {Ins B}}
               else
                  Set
               end
            end
         end
         tree(_ A Y B) = {Ins Set}    % guaranteed to be non-empty
      in
         tree(black A Y B)
      end
   end

[RedBlackSet] = {Module.apply [REDBLACKSET]}
{RedBlackSet.initialize OrderedValue}

{SetTest RedBlackSet}