PFDS Chapter #05 Examples in Oz
% 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]}

% 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 {QueueTest F}
   A = F.empty
   B = {F.snoc A 1}
   C = {F.snoc B 2}
   D = {F.snoc C 3}
in
   {Browse D}
   {Browse {F.head D}}
   {Browse {F.head {F.tail D}}}
   {Browse {F.head {F.tail {F.tail D}}}}
end

% 5.2 BatchedQueue
BATCHEDQUEUE =
   functor
   export
      empty   : Empty
      isEmpty : IsEmpty
      snoc    : Snoc
      head    : Head
      tail    : Tail
   define
      Empty = nil#nil
      fun {IsEmpty Q}
         case Q
         of nil#_ then true
         else false
         end
      end
      fun {CheckF Q}
         case Q
         of nil#R then {List.reverse R}#nil
         else Q
         end
      end
      fun {Snoc Q=F#R X}
         {CheckF F#(X|R)}
      end
      fun {Head Q}
         case Q
         of (H|T)#_ then H
         else raise empty end
         end
      end
      fun {Tail Q}
         case Q
         of (H|T)#R then {CheckF T#R}
         else raise empty end
         end
      end
   end

[BatchedQueue] = {Module.apply [BATCHEDQUEUE]}

{QueueTest BatchedQueue}

% 5.4 SplayHeap
SPLAYHEAP =
   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 {Partition Pivot Heap}
         case Heap
         of nil then nil#nil
         [] tree(A X B) then
            if {Element.leq X Pivot} then
               case B
               of nil then Heap#nil
               [] tree(B1 Y B2) then
                  if {Element.leq Y Pivot} then
                     local
                        Small#Big = {Partition Pivot B2}
                     in
                        tree(tree(A X B1) Y Small)#Big
                     end
                  else
                     local
                        Small#Big = {Partition Pivot B1}
                     in
                        tree(A X Small)#tree(Big Y B2)
                     end
                  end
               end
            else
               case A
               of nil then nil#Heap
               [] tree(A1 Y A2) then
                  if {Element.leq Y Pivot} then
                     local
                        Small#Big = {Partition Pivot A2}
                     in
                        tree(A1 Y Small)#tree(Big X B)
                     end
                  else
                     local
                        Small#Big = {Partition Pivot A1}
                     in
                        Small#tree(Big Y tree(A2 X B))
                     end
                  end
               end
            end
         end
      end
      fun {Insert X Heap}
         A#B = {Partition X Heap}
      in
         tree(A X B)
      end
      fun {Merge Heap1 Heap2}
         case Heap1
         of nil then Heap2
         [] tree(A X B) then
            local
               Ta#Tb = {Partition X Heap2}
            in
               tree({Merge Ta A} X {Merge Tb B})
            end
         end
      end
      fun {FindMin Heap}
         case Heap
         of tree(nil X B) then X
         [] tree(A X B) then {FindMin A}
         else raise empty end
         end
      end
      fun {DeleteMin Heap}
         case Heap
         of tree(nil X B) then B
         [] tree(tree(nil X B) Y C) then tree(B Y C)
         [] tree(tree(A X B) Y C) then tree({DeleteMin A} X tree(B Y C))
         else raise empty end
         end
      end
   end

[SplayHeap] = {Module.apply [SPLAYHEAP]}
{SplayHeap.initialize OrderedValue}

{HeapTest SplayHeap}

% 5.5 PairingHeap
PAIRINGHEAP =
   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 {Merge Heap1 Heap2}
         case Heap1#Heap2
         of _#nil then Heap1
         [] nil#_ then Heap2
         [] tree(X Hs1)#tree(Y Hs2) then
            if {Element.leq X Y} then
               tree(X Heap2|Hs1)
            else
               tree(Y Heap1|Hs2)
            end
         end
      end
      fun {Insert X Heap}
         {Merge tree(X nil) Heap}
      end
      fun {MergePairs HeapList}
         case HeapList
         of nil then nil
         [] [X] then X
         [] Heap1|Heap2|Hs then {Merge {Merge Heap1 Heap2} {MergePairs Hs}}
         end
      end
      fun {FindMin Heap}
         case Heap
         of tree(X Hs) then X
         else raise empty end
         end
      end
      fun {DeleteMin Heap}
         case Heap
         of tree(X Hs) then {MergePairs Hs}
         else raise empty end
         end
      end
   end

[PairingHeap] = {Module.apply [PAIRINGHEAP]}
{PairingHeap.initialize OrderedValue}

{HeapTest PairingHeap}