{-# language BangPatterns, RankNTypes, ScopedTypeVariables #-}
module Data.Vector.Algorithms where
import Prelude hiding (length)
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.ST (runST)
import Data.Vector.Generic.Mutable
import qualified Data.Vector.Generic as V
import qualified Data.Vector.Unboxed.Mutable as UMV
import qualified Data.Bit as Bit
import Data.Vector.Algorithms.Common (Comparison)
import Data.Vector.Algorithms.Intro (sortUniqBy)
import qualified Data.Vector.Algorithms.Search as S
nub :: forall v e . (V.Vector v e, Ord e) => v e -> v e
nub :: forall (v :: * -> *) e. (Vector v e, Ord e) => v e -> v e
nub = forall (v :: * -> *) e. Vector v e => Comparison e -> v e -> v e
nubBy forall a. Ord a => a -> a -> Ordering
compare
nubBy ::
forall v e . (V.Vector v e) =>
Comparison e -> v e -> v e
nubBy :: forall (v :: * -> *) e. Vector v e => Comparison e -> v e -> v e
nubBy Comparison e
cmp v e
vec = forall a. (forall s. ST s a) -> a
runST forall a b. (a -> b) -> a -> b
$ do
Mutable v s e
mv <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
v a -> m (Mutable v (PrimState m) a)
V.unsafeThaw v e
vec
Mutable v s e
destMV <- forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(Comparison e -> v (PrimState m) e -> m (v (PrimState m) e))
-> Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
nubByMut forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
sortUniqBy Comparison e
cmp Mutable v s e
mv
v e
v <- forall (m :: * -> *) (v :: * -> *) a.
(PrimMonad m, Vector v a) =>
Mutable v (PrimState m) a -> m (v a)
V.unsafeFreeze Mutable v s e
destMV
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (v :: * -> *) a. Vector v a => v a -> v a
V.force v e
v)
nubByMut ::
forall m v e . (PrimMonad m, MVector v e) =>
(Comparison e -> v (PrimState m) e -> m (v (PrimState m) e))
-> Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
nubByMut :: forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
(Comparison e -> v (PrimState m) e -> m (v (PrimState m) e))
-> Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
nubByMut Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
alg Comparison e
cmp v (PrimState m) e
inp = do
let len :: Int
len = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
inp
v (PrimState m) e
inp' <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> m (v (PrimState m) a)
clone v (PrimState m) e
inp
v (PrimState m) e
sortUniqs <- Comparison e -> v (PrimState m) e -> m (v (PrimState m) e)
alg Comparison e
cmp v (PrimState m) e
inp'
let uniqLen :: Int
uniqLen = forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
length v (PrimState m) e
sortUniqs
MVector (PrimState m) Bit
bitmask <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
Int -> a -> m (MVector (PrimState m) a)
UMV.replicate Int
uniqLen (Bool -> Bit
Bit.Bit Bool
False)
v (PrimState m) e
dest :: v (PrimState m) e <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
Int -> m (v (PrimState m) a)
unsafeNew Int
uniqLen
let
go :: Int -> Int -> m ()
go :: Int -> Int -> m ()
go !Int
srcInd !Int
destInd
| Int
srcInd forall a. Eq a => a -> a -> Bool
== Int
len = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Int
destInd forall a. Eq a => a -> a -> Bool
== Int
uniqLen = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise = do
e
curr <- forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> m a
unsafeRead v (PrimState m) e
inp Int
srcInd
Int
sortInd <- forall (m :: * -> *) (v :: * -> * -> *) e.
(PrimMonad m, MVector v e) =>
Comparison e -> v (PrimState m) e -> e -> m Int
S.binarySearchBy Comparison e
cmp v (PrimState m) e
sortUniqs e
curr
Bit
bit <- forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> m a
UMV.unsafeRead MVector (PrimState m) Bit
bitmask Int
sortInd
case Bit
bit of
Bit.Bit Bool
True -> Int -> Int -> m ()
go (Int
srcInd forall a. Num a => a -> a -> a
+ Int
1) Int
destInd
Bit.Bit Bool
False -> do
forall (m :: * -> *) a.
(PrimMonad m, Unbox a) =>
MVector (PrimState m) a -> Int -> a -> m ()
UMV.unsafeWrite MVector (PrimState m) Bit
bitmask Int
sortInd (Bool -> Bit
Bit.Bit Bool
True)
forall (m :: * -> *) (v :: * -> * -> *) a.
(PrimMonad m, MVector v a) =>
v (PrimState m) a -> Int -> a -> m ()
unsafeWrite v (PrimState m) e
dest Int
destInd e
curr
Int -> Int -> m ()
go (Int
srcInd forall a. Num a => a -> a -> a
+ Int
1) (Int
destInd forall a. Num a => a -> a -> a
+ Int
1)
Int -> Int -> m ()
go Int
0 Int
0
forall (f :: * -> *) a. Applicative f => a -> f a
pure v (PrimState m) e
dest