module Data.Array.Vector.Algorithms.Intro
(
sort
, sortBy
, sortByBounds
, select
, selectBy
, selectByBounds
, partialSort
, partialSortBy
, partialSortByBounds
, Comparison
) where
import Control.Monad
import Control.Monad.ST
import Data.Array.Vector
import Data.Array.Vector.Algorithms.Common
import Data.Bits
import qualified Data.Array.Vector.Algorithms.Insertion as I
import qualified Data.Array.Vector.Algorithms.Optimal as O
import qualified Data.Array.Vector.Algorithms.TriHeap as H
sort :: (UA e, Ord e) => MUArr e s -> ST s ()
sort = sortBy compare
sortBy :: (UA e) => Comparison e -> MUArr e s -> ST s ()
sortBy cmp a = sortByBounds cmp a 0 (lengthMU a)
sortByBounds :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> ST s ()
sortByBounds cmp a l u
| len < 2 = return ()
| len == 2 = O.sort2ByOffset cmp a l
| len == 3 = O.sort3ByOffset cmp a l
| len == 4 = O.sort4ByOffset cmp a l
| otherwise = introsort cmp a (ilg len) l u
where len = u l
introsort :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> Int -> ST s ()
introsort cmp a i l u = sort i l u >> I.sortByBounds cmp a l u
where
sort 0 l u = H.sortByBounds cmp a l u
sort d l u
| len < threshold = return ()
| otherwise = do O.sort3ByIndex cmp a c l (u1)
p <- readMU a l
mid <- partitionBy cmp a p (l+1) u
swap a l (mid 1)
sort (d1) mid u
sort (d1) l (mid 1)
where
len = u l
c = (u + l) `div` 2
select :: (UA e, Ord e) => MUArr e s -> Int -> ST s ()
select = selectBy compare
selectBy :: (UA e) => Comparison e -> MUArr e s -> Int -> ST s ()
selectBy cmp a k = selectByBounds cmp a k 0 (lengthMU a)
selectByBounds :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> Int -> ST s ()
selectByBounds cmp a k l u = go (ilg len) l (l + k) u
where
len = u l
go 0 l m u = H.selectByBounds cmp a (m l) l u
go n l m u = do O.sort3ByIndex cmp a c l (u1)
p <- readMU a l
mid <- partitionBy cmp a p (l+1) u
swap a l (mid 1)
if m > mid
then go (n1) mid m u
else if m < mid 1
then go (n1) l m (mid 1)
else return ()
where c = (u + l) `div` 2
partialSort :: (UA e, Ord e) => MUArr e s -> Int -> ST s ()
partialSort = partialSortBy compare
partialSortBy :: (UA e) => Comparison e -> MUArr e s -> Int -> ST s ()
partialSortBy cmp a k = partialSortByBounds cmp a k 0 (lengthMU a)
partialSortByBounds :: (UA e) => Comparison e -> MUArr e s -> Int -> Int -> Int -> ST s ()
partialSortByBounds cmp a k l u = go (ilg len) l (l + k) u
where
len = u l
go 0 l m n = H.partialSortByBounds cmp a (m l) l u
go n l m u
| l == m = return ()
| otherwise = do O.sort3ByIndex cmp a c l (u1)
p <- readMU a l
mid <- partitionBy cmp a p (l+1) u
swap a l (mid 1)
case compare m mid of
GT -> do introsort cmp a (n1) l (mid 1)
go (n1) mid m u
EQ -> introsort cmp a (n1) l m
LT -> go n l m (mid 1)
where c = (u + l) `div` 2
partitionBy :: (UA e) => Comparison e -> MUArr e s -> e -> Int -> Int -> ST s Int
partitionBy cmp a = partUp
where
partUp p l u
| l < u = do e <- readMU a l
case cmp e p of
LT -> partUp p (l+1) u
_ -> partDown p l (u1)
| otherwise = return l
partDown p l u
| l < u = do e <- readMU a u
case cmp p e of
LT -> partDown p l (u1)
_ -> swap a l u >> partUp p (l+1) u
| otherwise = return l
ilg :: Int -> Int
ilg m = 2 * loop m 0
where
loop 0 !k = k 1
loop n !k = loop (n `shiftR` 1) (k+1)
threshold :: Int
threshold = 18