PFDS Chapter #06 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 {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

proc {SortableTest F}
   A = F.empty
   B = {F.add 1 A}
   C = {F.add 2 B}
   D = {F.add 4 C}
   E = {F.add 3 D}
   L = {F.sort E}
in
   {Browse E}
   {Browse {Map L fun {$ X} {Wait X} X end}}
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]}

STREAM =
   functor
   export
      append   : Append
      take     : Take
      drop     : Drop
      reverse  : Reverse
      fromList : FromList
      toList   : ToList
   define
      fun lazy {Append L1 L2}
         case L1
         of nil then L2
         [] H|T then H|{Append T L2}
         end
      end
      fun {Take L N}
         if N == 0 then
            nil
         else
            case L
            of H|T then H|{Take T N-1}
            [] nil then nil
            end
         end
      end
      fun {Drop L N}
         if N == 0 then
            L
         else
            case L
            of H|T then {Drop T N-1}
            [] nil then nil
            end
         end
      end
      fun lazy {Reverse L}
         fun {Iter L1 L2}
            case L1
            of H|T then {Iter T H|L2}
            [] nil then L2
            end
         end
      in
         {Iter L nil}
      end
      fun {FromList L} L end
      fun {ToList L} L end
   end
[Stream] = {Module.apply [STREAM]}

% 6.3 BankersQueue
BANKERSQUEUE =
   functor
   export
      empty   : Empty
      isEmpty : IsEmpty
      snoc    : Snoc
      head    : Head
      tail    : Tail
   define
      Empty = 0#nil#0#nil
      fun {IsEmpty Q}
         case Q
         of LenF#_#_#_ then LenF == 0
         else false
         end
      end
      fun {Check Q=LenF#F#LenR#R}
         if LenR =< LenF then
            Q
         else
            LenF+LenR#{Stream.append F {Stream.reverse R}}#0#nil
         end
      end
      fun {Snoc Q=LenF#F#LenR#R X}
         {Check LenF#F#(LenR+1)#(X|R)}
      end
      fun {Head Q}
         case Q
         of LenF#(H|T)#LenR#R then H
         else raise empty end
         end
      end
      fun {Tail Q}
         case Q
         of LenF#(H|T)#LenR#R then {Check (LenF-1)#T#LenR#R}
         else raise empty end
         end
      end
   end

[BankersQueue] = {Module.apply [BANKERSQUEUE]}

{QueueTest BankersQueue}

% 6.4 LazyBinomialHeap
LAZYBINOMIALHEAP =
   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 lazy {Insert X Heap}
         {InsTree node(0 X nil) Heap}
      end
      fun lazy {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 lazy {DeleteMin Heap}
         node(_ X Ts1)#Ts2 = {RemoveMinTree Heap}
      in
         {Merge {List.reverse Ts1} Ts2}
      end
   end

[LazyBinomialHeap] = {Module.apply [LAZYBINOMIALHEAP]}
{LazyBinomialHeap.initialize OrderedValue}

{HeapTest LazyBinomialHeap}

% 6.4 PhysicistsQueue
PHYSICISTSQUEUE =
   functor
   export
      empty   : Empty
      isEmpty : IsEmpty
      snoc    : Snoc
      head    : Head
      tail    : Tail
   define
      Empty = nil#0#nil#0#nil
      fun {IsEmpty Q}
         case Q
         of _#LenF#_#_#_ then LenF == 0
         else false
         end
      end
      fun {CheckW Q}
         case Q
         of nil#LenF#F#LenR#R then
            {Wait F}
            F#LenF#F#LenR#R
         else Q
         end
      end
      fun {Check Q=W#LenF#F#LenR#R}
         if LenR =< LenF then
            {CheckW Q}
         else
            {Wait F}
            {CheckW F#(LenF+LenR)#{fun lazy {$} {Append F {List.reverse R}} end}#0#nil}
         end
      end
      fun {Snoc Q=W#LenF#F#LenR#R X}
         {Check W#LenF#F#(LenR+1)#(X|R)}
      end
      fun {Head Q}
         case Q
         of (X|W)#LenF#F#LenR#R then X
         else raise empty end
         end
      end
      fun {Tail Q}
         case Q
         of (X|W)#LenF#F#LenR#R then
            {Check W#(LenF-1)#{fun lazy {$} F.2 end}#LenR#R}
         else raise empty end
         end
      end
   end

[PhysicistsQueue] = {Module.apply [PHYSICISTSQUEUE]}

{QueueTest PhysicistsQueue}

% 6.4 BottomUpMergeSort
BOTTOMUPMERGESORT =
   functor
   export
      initialize : Initialize
      empty      : Empty
      add        : Add
      sort       : Sort
   define
      Element
      proc {Initialize OrderedSet} Element = OrderedSet end
      Empty = 0#nil
      fun {Mrg Set1 Set2}
         case Set1#Set2
         of nil#_ then Set2
         [] _#nil then Set1
         [] (H1|T1)#(H2|T2) then
            if {Element.leq H1 H2} then
               H1 | {Mrg T1 Set2}
            else
               H2 | {Mrg Set1 T2}
            end
         end
      end
      fun {Add X Set=Size#Segs}
         fun {AddSeg Seg Segs Size}
            if Size mod 2 == 0 then
               Seg | Segs
            else
               {AddSeg {Mrg Seg Segs.1} Segs.2 (Size div 2)}
            end
         end
      in
         (Size+1)#{fun lazy {$} {Wait Segs} {AddSeg [X] Segs Size} end}
      end
      fun {Sort Set=Size#Segs}
         fun {MrgAll Xs Ys}
            case Ys
            of Seg|Segs then {MrgAll {Mrg Xs Seg} Segs}
            [] nil then Xs
            end
         end
      in
         {Wait Segs}
         {MrgAll nil Segs}
      end
   end

[BottomUpMergeSort] = {Module.apply [BOTTOMUPMERGESORT]}
{BottomUpMergeSort.initialize OrderedValue}

{SortableTest BottomUpMergeSort}

% 6.5 LazyPairingHeap
LAZYPAIRINGHEAP =
   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 _ _)#tree(Y _ _) then
            if {Element.leq X Y} then
               {Link Heap1 Heap2}
            else
               {Link Heap2 Heap1}
            end
         end
      end
      fun {Link Heap A}
         case Heap
         of tree(X nil M) then tree(X A M)
         [] tree(X B M) then tree(X nil {fun lazy {$} {Wait M} {Merge {Merge A B} M} end})
         end
      end
      fun {Insert X Heap}
         {Merge tree(X nil nil) Heap}
      end
      fun {FindMin Heap}
         case Heap
         of tree(X _ _) 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

[LazyPairingHeap] = {Module.apply [LAZYPAIRINGHEAP]}
{LazyPairingHeap.initialize OrderedValue}

{HeapTest LazyPairingHeap}