{------------------------------------------------------------------------------
                                 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 :: (a -> a -> Bool) -> [a] -> [a]
isort a -> a -> Bool
(<=) = (a -> [a] -> [a]) -> [a] -> [a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> a -> Bool) -> a -> [a] -> [a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
insrt a -> a -> Bool
(<=)) []

insrt:: (a->a->Bool) -> a -> [a] -> [a]
insrt :: (a -> a -> Bool) -> a -> [a] -> [a]
insrt a -> a -> Bool
_    a
e [] = [a
e]
insrt a -> a -> Bool
(<=) a
e l :: [a]
l@(a
h:[a]
t) = if a
ea -> a -> Bool
<=a
h then a
ea -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
l else a
ha -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Bool) -> a -> [a] -> [a]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
insrt a -> a -> Bool
(<=) a
e [a]
t


msort :: (a->a->Bool) -> [a] -> [a]
msort :: (a -> a -> Bool) -> [a] -> [a]
msort a -> a -> Bool
_    [] = []                    -- (foldb f []) is undefined
msort a -> a -> Bool
(<=) [a]
xs = ([a] -> [a] -> [a]) -> [[a]] -> [a]
forall a. (a -> a -> a) -> [a] -> a
foldb ((a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
mrg a -> a -> Bool
(<=)) ((a -> a -> Bool) -> [a] -> [[a]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
runs a -> a -> Bool
(<=) [a]
xs)

runs :: (a->a->Bool) -> [a] -> [[a]]
runs :: (a -> a -> Bool) -> [a] -> [[a]]
runs a -> a -> Bool
(<=) [a]
xs0 = (a -> [[a]] -> [[a]]) -> [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> [[a]] -> [[a]]
op [] [a]
xs0
      where
        op :: a -> [[a]] -> [[a]]
op a
z xss :: [[a]]
xss@(xs :: [a]
xs@(a
x:[a]
_):[[a]]
xss') | a
za -> a -> Bool
<=a
x      = (a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs)[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
xss'
                                 | Bool
otherwise = [a
z][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
xss
        op a
z [[a]]
xss                             = [a
z][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
xss

foldb :: (a->a->a) -> [a] -> a
foldb :: (a -> a -> a) -> [a] -> a
foldb a -> a -> a
_ [a
x] = a
x
foldb a -> a -> a
f [a]
xs0 = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
foldb a -> a -> a
f ([a] -> [a]
fold [a]
xs0)
      where
        fold :: [a] -> [a]
fold (a
x1:a
x2:[a]
xs) = a -> a -> a
f a
x1 a
x2 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a] -> [a]
fold [a]
xs
        fold [a]
xs         = [a]
xs

mrg:: (a->a->Bool) -> [a] -> [a] -> [a]
mrg :: (a -> a -> Bool) -> [a] -> [a] -> [a]
mrg a -> a -> Bool
_    [] [a]
l = [a]
l
mrg a -> a -> Bool
_    l :: [a]
l@(a
_:[a]
_) [] = [a]
l
mrg a -> a -> Bool
(<=) l1 :: [a]
l1@(a
h1:[a]
t1) l2 :: [a]
l2@(a
h2:[a]
t2) =
        if a
h1a -> a -> Bool
<=a
h2
           then a
h1a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
mrg a -> a -> Bool
(<=) [a]
t1 [a]
l2
           else a
h2a -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Bool) -> [a] -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
mrg a -> a -> Bool
(<=) [a]
l1 [a]
t2


nub':: (a->a->Bool) -> [a] -> [a]
nub' :: (a -> a -> Bool) -> [a] -> [a]
nub' a -> a -> Bool
(<=) [a]
l = (a -> a -> Bool) -> (a -> [a] -> a) -> [a] -> [a]
forall a b. (a -> a -> Bool) -> (a -> [a] -> b) -> [a] -> [b]
group_sort a -> a -> Bool
(<=) a -> [a] -> a
forall a b. a -> b -> a
const [a]
l


group_sort:: (a->a->Bool) -> (a->[a]->b) -> [a] -> [b]
group_sort :: (a -> a -> Bool) -> (a -> [a] -> b) -> [a] -> [b]
group_sort a -> a -> Bool
le a -> [a] -> b
cmb [a]
l = [a] -> [b]
s_m ((a -> a -> Bool) -> [a] -> [a]
forall a. (a -> a -> Bool) -> [a] -> [a]
msort a -> a -> Bool
le [a]
l)
        where
        s_m :: [a] -> [b]
s_m [] = []
        s_m (a
h:[a]
t) = a -> [a] -> b
cmb a
h ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (a -> a -> Bool
`le` a
h) [a]
t)b -> [b] -> [b]
forall a. a -> [a] -> [a]
:[a] -> [b]
s_m ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (a -> a -> Bool
`le` a
h) [a]
t)