> module Sort ( qsort, qsortBy,
> mergeSort, mergeSortBy,
> merge, mergeLists, mergeBy, mergeListsBy,
> naturalSort, naturalSortBy,
> uniqueBy, unique
> )
> where
Quicksort
> qsort :: Ord a => [a] -> [a]
> qsort = qsortBy (<=)
>
> qsortBy :: (a -> a -> Bool) -> [a] -> [a]
> qsortBy (<=) x = qsortsBy (<=) x []
The following code is due to Lennart Augustsson.
> qsortsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
> qsortsBy (<=) [] y = y
> qsortsBy (<=) [a] y = a:y
> qsortsBy (<=) (a:x) y = qpartBy (<=) a x [] [] y
qpartBy partitions and sorts the sublists. Note that l and r
are in reverse order and must be sorted with an anti-stable sorting.
> qpartBy (<=) a [] l r y = rqsortsBy (<=) l (a : rqsortsBy (<=) r y)
> qpartBy (<=) a (b:x) l r y
> | a <= b = qpartBy (<=) a x l (b:r) y
> | otherwise = qpartBy (<=) a x (b:l) r y
rqsortsBy is as qsortsBy but anti-stable, ie reverses equal elements.
> rqsortsBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
> rqsortsBy (<=) [] y = y
> rqsortsBy (<=) [a] y = a:y
> rqsortsBy (<=) (a:x) y = rqpartBy (<=) a x [] [] y
> rqpartBy (<=) a [] l r y = qsortsBy (<=) l (a : qsortsBy (<=) r y)
> rqpartBy (<=) a (b:x) l r y
> | b <= a = rqpartBy (<=) a x (b:l) r y
> | otherwise = rqpartBy (<=) a x l (b:r) y
Mergesort
Bottom-up Variant of mergesort.
> mergeSort :: Ord a => [a] -> [a]
> mergeSort = mergeSortBy (<=)
> mergeSortBy :: (a -> a -> Bool) -> [a] -> [a]
> mergeSortBy (<=) = mergeListsBy (<=) . runPhase
> where
Building "runs" of length 2.
> runPhase [] = []
> runPhase [a] = [[a]]
> runPhase (a:b:x)
> | a <= b = [a,b] : runPhase x
> | otherwise = [b,a] : runPhase x
Merging two lists.
> merge :: Ord a => [a] -> [a] -> [a]
> merge = mergeBy (<=)
>
> mergeBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
> mergeBy (<=) [] y = y
> mergeBy (<=) (a:x) [] = a : x
> mergeBy (<=) v@(a:x) w@(b:y)
> | a <= b = a : mergeBy (<=) x w
> | otherwise = b : mergeBy (<=) v y
Iteratively merging the runs. Good for its own sake.
> mergeLists :: Ord a => [[a]] -> [a]
> mergeLists = mergeListsBy (<=)
>
> mergeListsBy :: (a -> a -> Bool) -> [[a]] -> [a]
> mergeListsBy (<=) = mergeLists
> where
> mergeLists [] = []
> mergeLists [x] = x
> mergeLists (x1:x2:xs) = mergeLists (mergeBy (<=) x1 x2:mergePairs xs)
>
> mergePairs [] = []
> mergePairs [x] = [x]
> mergePairs (x1:x2:xs) = mergeBy (<=) x1 x2 : mergePairs xs
Natural mergesort
Natural mergesort respect runs of the given list.
> naturalSort :: Ord a => [a] -> [a]
> naturalSort = naturalSortBy (<=)
> naturalSortBy :: (a -> a -> Bool) -> [a] -> [a]
> naturalSortBy (<=) = mergeListsBy (<=) . runPhase
> where
Splitting into runs. takeAsc takes an ascending prefix.
> runPhase [] = [[]]
> runPhase (a:x) = takeAsc [a] x
>
> takeAsc as [] = [reverse as]
> takeAsc as@(a:_) (e:x)
> | a <= e = takeAsc (e:as) x
> | otherwise = takeAscDes as [e] x
>
> takeAscDes as ds [] = [mergeBy (<=) (reverse as) ds]
> takeAscDes as@(a:_) ds@(d:_) v@(e:x)
> | a <= e = takeAscDes (e:as) ds x
> | d <= e = mergeBy (<=) (reverse as) ds : runPhase v
> | otherwise = takeAscDes as (e:ds) x
ToDo: Is naturalSortBy stable?
Misc
> uniqueBy :: (a -> a -> Bool) -> [a] -> [a]
> uniqueBy (==) [] = []
> uniqueBy (==) [a] = [a]
> uniqueBy (==) (a:x@(b:_)) | a==b = uniqueBy (==) x
> | otherwise = a : uniqueBy (==) x
> unique :: Eq a => [a] -> [a]
> unique = uniqueBy (==)