> 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 (==)