(*** Orders ***) signature ORDER = sig type t val leq: t * t -> bool end ; structure LeqIntOrder = struct type t = int ; val leq = op<= ; end ; load"Real" ; structure LeqRealOrder = struct type t = real ; val leq = Real.<= ; end ; functor Op( O: ORDER ) : ORDER = struct type t = O.t ; fun leq(x,y) = O.leq(y,x) ; end ; structure GeqIntOrder = Op(LeqIntOrder) ; structure GeqRealOrder = Op(LeqRealOrder) ; (*** Sorters ***) signature SORTER = sig type t val sort: t list -> t list end ; (*** Insert Sorter ***) functor InsertSort (O: ORDER) : SORTER = struct type t = O.t ; fun ins( x , []) = [x] | ins( x , h::t ) = if O.leq(x,h) then x::h::t else h::ins(x,t) ; val sort = foldl ins [] ; end ; structure IntInsertSort = InsertSort( LeqIntOrder ) ; IntInsertSort.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealInsertSort = InsertSort( GeqRealOrder ) ; RealInsertSort.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ; (*** Top-Down Merge Sorter ***) functor TDMergeSort (O: ORDER) : SORTER = struct type t = O.t ; fun merge( [] , l2 ) = l2 | merge( l1 , [] ) = l1 | merge( h1::t1 , h2::t2 ) = if O.leq(h1,h2) then h1::merge( t1 , h2::t2 ) else h2::merge( h1::t1 , t2 ) ; fun sort [] = [] | sort [x] = [x] | sort l = let val n = length l div 2 in merge( sort( List.take(l,n) ) , sort( List.drop(l,n) ) ) end ; end ; structure IntTDMergeSort = TDMergeSort( LeqIntOrder ) ; IntTDMergeSort.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealTDMergeSort = TDMergeSort( GeqRealOrder ) ; RealTDMergeSort.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ; (*** Top-Down Merge Sorter ***) (*** eliminating take and drop ***) functor TDMergeSort1 (O: ORDER) : SORTER = struct type t = O.t ; fun merge( [] , l2 ) = l2 | merge( l1 , [] ) = l1 | merge( h1::t1 , h2::t2 ) = if O.leq(h1,h2) then h1::merge( t1 , h2::t2 ) else h2::merge( h1::t1 , t2 ) ; fun sort l = let fun msort( 0 , l ) = ( [] , l ) | msort( 1 , h::t ) = ( [h] , t ) | msort( n , l ) = let val (sl1,l1) = msort( (n+1) div 2 , l ) val (sl2,l2) = msort( n div 2 , l1 ) in ( merge(sl1,sl2) , l2 ) end ; val (sl,_) = msort( length l , l ) ; in sl end end ; structure IntTDMergeSort1 = TDMergeSort1( LeqIntOrder ) ; IntTDMergeSort1.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealTDMergeSort1 = TDMergeSort1( GeqRealOrder ) ; RealTDMergeSort1.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ; (*** Bottom-Up Merge Sorter ***) functor BUMergeSort (O: ORDER) : SORTER = struct type t = O.t ; fun merge( [] , l2 ) = l2 | merge( l1 , [] ) = l1 | merge( h1::t1 , h2::t2 ) = if O.leq(h1,h2) then h1::merge( t1 , h2::t2 ) else h2::merge( h1::t1 , t2 ) ; fun mergepairs( [l] , k ) = [l] | mergepairs( l1::l2::t , k ) = if k mod 2 = 1 then l1::l2::t else mergepairs( merge(l1,l2)::t , k div 2) ; fun sort l = let fun msort( [] , l , k ) = hd( mergepairs(l,0) ) | msort( h::t , l , k ) = msort( t , mergepairs([h]::l,k+1) , k+1 ) in msort( l , [ [] ] , 0 ) end ; end ; structure IntBUMergeSort = BUMergeSort( LeqIntOrder ) ; IntBUMergeSort.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealBUMergeSort = BUMergeSort( GeqRealOrder ) ; RealBUMergeSort.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ; (*** Smooth Applicative Merge Sorter ***) functor SAMergeSort (O: ORDER) : SORTER = struct type t = O.t ; fun merge( [] , l2 ) = l2 | merge( l1 , [] ) = l1 | merge( h1::t1 , h2::t2 ) = if O.leq(h1,h2) then h1::merge( t1 , h2::t2 ) else h2::merge( h1::t1 , t2 ) ; fun mergepairs( [l] , k ) = [l] | mergepairs( l1::l2::t , k ) = if k mod 2 = 1 then l1::l2::t else mergepairs( merge(l1,l2)::t , k div 2) ; fun nextrun( run , [] ) = ( rev run , [] ) | nextrun( run , h::t ) = if O.leq(h,hd run) then ( rev run , h::t ) else nextrun( h::run , t ) ; fun samsorting( [] , l , k ) = hd( mergepairs(l,0) ) | samsorting( h::t , l, k ) = let val (run,tail) = nextrun( [h] , t ) ; in samsorting( tail , mergepairs(run::l,k+1) , k+1 ) end; fun sort l = samsorting( l , [ [] ] , 0 ); end ; structure IntSAMergeSort = SAMergeSort( LeqIntOrder ) ; IntSAMergeSort.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealSAMergeSort = SAMergeSort( GeqRealOrder ) ; RealSAMergeSort.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ; (*** Quick Sorter ***) functor QuickSort (O: ORDER) : SORTER = struct type t = O.t ; fun sort [] = [] | sort (h::t) = case List.partition ( fn x => O.leq(x,h) ) t of (left,right) => sort left @ h::sort right ; end ; structure IntQuickSort = QuickSort( LeqIntOrder ) ; IntQuickSort.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealQuickSort = QuickSort( GeqRealOrder ) ; RealQuickSort.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ; (*** Quick Sorter ***) (*** without List.partition ***) functor QuickSort1 (O: ORDER) : SORTER = struct type t = O.t ; fun sort [] = [] | sort [x] = [x] | sort (h::t) = let fun part( left , right , [] ) = (sort left) @ h::sort right | part( left , right , h1::t1 ) = if O.leq(h1,h) then part(h1::left,right,t1) else part(left,h1::right,t1) in part( [] , [] , t ) end ; end ; structure IntQuickSort1 = QuickSort1( LeqIntOrder ) ; IntQuickSort1.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealQuickSort1 = QuickSort1( GeqRealOrder ) ; RealQuickSort1.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ; (*** Quick Sorter ***) (*** without append ***) functor QuickSort2 (O: ORDER) : SORTER = struct type t = O.t ; fun quick( [] , sorted ) = sorted | quick( [x] , sorted ) = x::sorted | quick ( h::t, sorted ) = let fun part( left , right , [] ) = quick( left , h::quick(right,sorted) ) | part( left , right , h1::t1 ) = if O.leq(h1,h) then part(h1::left,right,t1) else part(left,h1::right,t1) in part( [] , [] , t ) end ; fun sort l = quick( l, [] ) ; end ; structure IntQuickSort2 = QuickSort2( LeqIntOrder ) ; IntQuickSort2.sort [9,8,7,6,5,4,3,2,1,0] ; structure RealQuickSort2 = QuickSort2( GeqRealOrder ) ; RealQuickSort2.sort ( map (fn x => real x) [0,1,2,3,4,5,6,7,8,9] ) ;