{------------------------------------------------------------------------------ SORTING LISTS This module provides properly parameterised insertion and merge sort functions, complete with associated functions for inserting and merging. `isort' is the standard lazy version and can be used to the minimum k elements of a list in linear time. The merge sort is based on a Bob Buckley's (Bob Buckley 18-AUG-95) coding of Knuth's natural merge sort (see Vol. 2). It seems to be fast in the average case; it makes use of natural runs in the data becomming linear on ordered data; and it completes in worst time O(n.log(n)). It is divinely elegant. `nub'' is an n.log(n) version of `nub' and `group_sort' sorts a list into strictly ascending order, using a combining function in its arguments to amalgamate duplicates. Chris Dornan, 14-Aug-93, 17-Nov-94, 29-Dec-95 ------------------------------------------------------------------------------} module Sort where -- Hide (<=) so that we don't get name shadowing warnings for it import Prelude hiding ((<=)) -- `isort' is an insertion sort and is here for historical reasons; msort is -- better in almost every situation. isort:: (a->a->Bool) -> [a] -> [a] isort (<=) = foldr (insrt (<=)) [] insrt:: (a->a->Bool) -> a -> [a] -> [a] insrt _ e [] = [e] insrt (<=) e l@(h:t) = if e<=h then e:l else h:insrt (<=) e t msort :: (a->a->Bool) -> [a] -> [a] msort _ [] = [] -- (foldb f []) is undefined msort (<=) xs = foldb (mrg (<=)) (runs (<=) xs) runs :: (a->a->Bool) -> [a] -> [[a]] runs (<=) xs0 = foldr op [] xs0 where op z xss@(xs@(x:_):xss') | z<=x = (z:xs):xss' | otherwise = [z]:xss op z xss = [z]:xss foldb :: (a->a->a) -> [a] -> a foldb _ [x] = x foldb f xs0 = foldb f (fold xs0) where fold (x1:x2:xs) = f x1 x2 : fold xs fold xs = xs mrg:: (a->a->Bool) -> [a] -> [a] -> [a] mrg _ [] l = l mrg _ l@(_:_) [] = l mrg (<=) l1@(h1:t1) l2@(h2:t2) = if h1<=h2 then h1:mrg (<=) t1 l2 else h2:mrg (<=) l1 t2 nub':: (a->a->Bool) -> [a] -> [a] nub' (<=) l = group_sort (<=) const l group_sort:: (a->a->Bool) -> (a->[a]->b) -> [a] -> [b] group_sort le cmb l = s_m (msort le l) where s_m [] = [] s_m (h:t) = cmb h (takeWhile (`le` h) t):s_m (dropWhile (`le` h) t)