{-# LANGUAGE MultiParamTypeClasses #-}
module Basement.Alg.Mutable
( inplaceSortBy
) where
import GHC.Types
import GHC.Prim
import Basement.Compat.Base
import Basement.Numerical.Additive
import Basement.Numerical.Multiplicative
import Basement.Types.OffsetSize
import Basement.PrimType
import Basement.Monad
import Basement.Alg.Class
inplaceSortBy :: (PrimMonad prim, RandomAccess container prim ty)
=> (ty -> ty -> Ordering)
-> (Offset ty)
-> (CountOf ty)
-> container
-> prim ()
inplaceSortBy :: (ty -> ty -> Ordering)
-> Offset ty -> CountOf ty -> container -> prim ()
inplaceSortBy ty -> ty -> Ordering
ford Offset ty
start CountOf ty
len container
mvec
= Offset ty -> Offset ty -> prim ()
qsort Offset ty
start (Offset ty
start Offset ty -> CountOf ty -> Offset ty
forall ty. Offset ty -> CountOf ty -> Offset ty
`offsetPlusE` CountOf ty
len Offset ty -> Offset ty -> Offset ty
forall a. Offset a -> Offset a -> Offset a
`offsetSub` Offset ty
1)
where
qsort :: Offset ty -> Offset ty -> prim ()
qsort Offset ty
lo Offset ty
hi
| Offset ty
lo Offset ty -> Offset ty -> Bool
forall a. Ord a => a -> a -> Bool
>= Offset ty
hi = () -> prim ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
Offset ty
p <- Offset ty -> Offset ty -> prim (Offset ty)
partition Offset ty
lo Offset ty
hi
Offset ty -> Offset ty -> prim ()
qsort Offset ty
lo (Offset ty -> Offset ty
forall a. Enum a => a -> a
pred Offset ty
p)
Offset ty -> Offset ty -> prim ()
qsort (Offset ty
pOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1) Offset ty
hi
pivotStrategy :: Offset ty -> Offset ty -> prim ty
pivotStrategy (Offset Int
low) hi :: Offset ty
hi@(Offset Int
high) = do
let mid :: Offset ty
mid = Int -> Offset ty
forall ty. Int -> Offset ty
Offset (Int -> Offset ty) -> Int -> Offset ty
forall a b. (a -> b) -> a -> b
$ (Int
low Int -> Int -> Int
forall a. Additive a => a -> a -> a
+ Int
high) Int -> Int -> Int
forall a. IDivisible a => a -> a -> a
`div` Int
2
ty
pivot <- container -> Offset ty -> prim ty
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> prim ty
read container
mvec Offset ty
mid
container -> Offset ty -> prim ty
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> prim ty
read container
mvec Offset ty
hi prim ty -> (ty -> prim ()) -> prim ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= container -> Offset ty -> ty -> prim ()
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> ty -> prim ()
write container
mvec Offset ty
mid
container -> Offset ty -> ty -> prim ()
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> ty -> prim ()
write container
mvec Offset ty
hi ty
pivot
ty -> prim ty
forall (f :: * -> *) a. Applicative f => a -> f a
pure ty
pivot
partition :: Offset ty -> Offset ty -> prim (Offset ty)
partition Offset ty
lo Offset ty
hi = do
ty
pivot <- Offset ty -> Offset ty -> prim ty
pivotStrategy Offset ty
lo Offset ty
hi
let go :: Offset ty -> Offset ty -> prim (Offset ty)
go Offset ty
i Offset ty
j = do
let fw :: Offset ty -> prim (Offset ty, ty)
fw Offset ty
k = do ty
ak <- container -> Offset ty -> prim ty
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> prim ty
read container
mvec Offset ty
k
if ty -> ty -> Ordering
ford ty
ak ty
pivot Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
then Offset ty -> prim (Offset ty, ty)
fw (Offset ty
kOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1)
else (Offset ty, ty) -> prim (Offset ty, ty)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset ty
k, ty
ak)
(Offset ty
i, ty
ai) <- Offset ty -> prim (Offset ty, ty)
fw Offset ty
i
let bw :: Offset ty -> prim (Offset ty, ty)
bw Offset ty
k | Offset ty
kOffset ty -> Offset ty -> Bool
forall a. Eq a => a -> a -> Bool
==Offset ty
i = (Offset ty, ty) -> prim (Offset ty, ty)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset ty
i, ty
ai)
| Bool
otherwise = do ty
ak <- container -> Offset ty -> prim ty
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> prim ty
read container
mvec Offset ty
k
if ty -> ty -> Ordering
ford ty
ak ty
pivot Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
then Offset ty -> prim (Offset ty, ty)
bw (Offset ty -> Offset ty
forall a. Enum a => a -> a
pred Offset ty
k)
else (Offset ty, ty) -> prim (Offset ty, ty)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Offset ty
k, ty
ak)
(Offset ty
j, ty
aj) <- Offset ty -> prim (Offset ty, ty)
bw Offset ty
j
if Offset ty
i Offset ty -> Offset ty -> Bool
forall a. Ord a => a -> a -> Bool
< Offset ty
j
then do
container -> Offset ty -> ty -> prim ()
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> ty -> prim ()
write container
mvec Offset ty
i ty
aj
container -> Offset ty -> ty -> prim ()
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> ty -> prim ()
write container
mvec Offset ty
j ty
ai
Offset ty -> Offset ty -> prim (Offset ty)
go (Offset ty
iOffset ty -> Offset ty -> Offset ty
forall a. Additive a => a -> a -> a
+Offset ty
1) (Offset ty -> Offset ty
forall a. Enum a => a -> a
pred Offset ty
j)
else do
container -> Offset ty -> ty -> prim ()
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> ty -> prim ()
write container
mvec Offset ty
hi ty
ai
container -> Offset ty -> ty -> prim ()
forall container (prim :: * -> *) ty.
RandomAccess container prim ty =>
container -> Offset ty -> ty -> prim ()
write container
mvec Offset ty
i ty
pivot
Offset ty -> prim (Offset ty)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Offset ty
i
Offset ty -> Offset ty -> prim (Offset ty)
go Offset ty
lo Offset ty
hi
{-# INLINE inplaceSortBy #-}