PFDS Chapter #07 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]}

% 7.2 RealTimeQueue
REALTIMEQUEUE =
   functor
   export
      empty   : Empty
      isEmpty : IsEmpty
      snoc    : Snoc
      head    : Head
      tail    : Tail
   define
      Empty = nil#nil#nil
      fun {IsEmpty Q}
         case Q
         of nil#_#_ then true
         else false
         end
      end
      fun lazy {Rotate Q}
         case Q
         of nil#(Y|_)#A then Y|A
         [] (X|Xs)#(Y|Ys)#A then X|{Rotate Xs#Ys#(Y|A)}
         end
      end
      fun {Exec Q}
         case Q
         of F#R#(X|S) then F#R#S
         [] F#R#nil then
            local
               Xs = {Rotate F#R#nil}
            in
               Xs#nil#Xs
            end
         end
      end
      fun {Snoc Q=F#R#S X}
         {Exec F#(X|R)#S}
      end
      fun {Head Q}
         case Q
         of (H|T)#R#S then H
         else raise empty end
         end
      end
      fun {Tail Q}
         case Q
         of (H|T)#R#S then {Exec T#R#S}
         else raise empty end
         end
      end
   end

[RealTimeQueue] = {Module.apply [REALTIMEQUEUE]}

{QueueTest RealTimeQueue}

% 7.3 ScheduledBinomialHeap
SCHEDULEDBINOMIALHEAP =
   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#nil
      fun {IsEmpty Heap}
         case Heap
         of nil#_ then true
         else false
         end
      end
      fun {Link Tree1=node(X1 C1) Tree2=node(X2 C2)}
         if {Element.leq X1 X2} then
            node(X1 Tree2|C1)
         else
            node(X2 Tree1|C2)
         end
      end
      fun lazy {InsTree Tree L}
         case L
         of nil then one(Tree)|nil
         [] zero|T then one(Tree)|T
         [] one(X)|T then zero|{InsTree {Link Tree X} T}
         end
      end
      fun lazy {Mrg L1 L2}
         case L1#L2
         of _#nil then L1
         [] nil#_ then L2
         [] (zero|T1)#(H2|T2) then H2|{Mrg T1 T2}
         [] (H1|T1)#(zero|T2) then H1|{Mrg T1 T2}
         [] (one(Tree1)|T1)#(one(Tree2)|T2) then zero|{InsTree {Link Tree1 Tree2} {Mrg T1 T2}}
         end
      end
      fun {Normalize L}
         case L
         of nil then L
         [] _|T then
            _ = {Normalize T}
            L
         end
      end
      fun {Exec Schedule}
         case Schedule
         of nil then nil
         [] (zero#Job)|T then Job|T
         [] _|T then T
         end
      end
      fun {Insert X Heap=L#Schedule}
         Xs = {InsTree node(X nil) L}
      in
         Xs#{Exec {Exec Xs|Schedule}}
      end
      fun {Merge Heap1=L1#_ Heap2=L2#_}
         L = {Normalize {Mrg L1 L2}}
      in
         L#nil
      end
      fun {RemoveMinTree L}
         case L
         of nil then raise empty end
         [] one(Tree)|nil then Tree#nil
         [] zero|T then
            local
               Tree#Lx = {RemoveMinTree T}
            in
               Tree#(zero|Lx)
            end
         [] one(Tree)|T then
            local
               node(X _) = Tree
               Tx#Dx = {RemoveMinTree T}
               node(Y _) = Tx
            in
               if {Element.leq X Y} then
                  Tree#(zero|T)
               else
                  Tx#(one(Tree)|Dx)
               end
            end
         end
      end
      fun {FindMin Heap=L#_}
         node(X _)#_ = {RemoveMinTree L}
      in
         X
      end
      fun {DeleteMin Heap=L#_}
         node(X C)#Xs = {RemoveMinTree L}
         Ys = {Mrg {Map {List.reverse C} fun {$ A} one(A) end} Xs}
      in
         {Normalize Ys}#nil
      end
   end

[ScheduledBinomialHeap] = {Module.apply [SCHEDULEDBINOMIALHEAP]}
{ScheduledBinomialHeap.initialize OrderedValue}

{HeapTest ScheduledBinomialHeap}

% 7.4 ScheduledBottomUpMergeSort
SCHEDULEDBOTTOMUPMERGESORT =
   functor
   export
      initialize : Initialize
      empty      : Empty
      add        : Add
      sort       : Sort
   define
      Element
      proc {Initialize OrderedSet} Element = OrderedSet end
      Empty = 0#nil
      fun lazy {Mrg S1 S2}
         case S1#S2
         of nil#_ then S2
         [] _#nil then S1
         [] (H1|T1)#(H2|T2) then
            if {Element.leq H1 H2} then
               H1 | {Mrg T1 S2}
            else
               H2 | {Mrg S1 T2}
            end
         end
      end
      fun {Exec1 L}
         case L
         of nil then nil
         [] nil|Sched then {Exec1 Sched}
         [] (H|T)|Sched then T|Sched
         end
      end
      fun {Exec2 Xs#Sched}
         Xs#{Exec1 {Exec1 Sched}}
      end
      fun {Add X Size#Segs}
         fun {AddSeg Xs Segs Size Rsched}
            if Size mod 2 == 0 then
               (Xs#{List.reverse Rsched})|Segs
            else
               local
                  (Ys#nil)|L = Segs
                  Zs = {Mrg Xs Ys}
               in
                  {AddSeg Zs L (Size div 2) Zs|Rsched}
               end
            end
         end
         L = {AddSeg X|nil Segs Size nil}
      in
         (Size+1)#{Map L Exec2}
      end
      fun {Sort Size#Segs}
         fun {MrgAll Xs Ys}
            case Ys
            of (Ys#_)|Segs then {MrgAll {Mrg Xs Ys} Segs}
            [] nil then Xs
            end
         end
      in
         {MrgAll nil Segs}
      end
   end

[ScheduledBottomUpMergeSort] = {Module.apply [SCHEDULEDBOTTOMUPMERGESORT]}
{ScheduledBottomUpMergeSort.initialize OrderedValue}

{SortableTest ScheduledBottomUpMergeSort}