vector-algorithms 0.3.4 → 0.4
raw patch · 6 files changed
+87/−114 lines, 6 filesdep ~primitivedep ~vector
Dependency ranges changed: primitive, vector
Files
- Data/Vector/Algorithms/Combinators.hs +1/−6
- Data/Vector/Algorithms/Merge.hs +6/−71
- Data/Vector/Algorithms/Search.hs +62/−26
- tests/Properties.hs +16/−6
- tests/Tests.hs +0/−2
- vector-algorithms.cabal +2/−3
Data/Vector/Algorithms/Combinators.hs view
@@ -15,7 +15,7 @@ -- applying the algorithms on mutable arrays to immutable arrays. module Data.Vector.Algorithms.Combinators- ( apply+ ( -- , usingKeys -- , usingIxKeys ) where@@ -30,11 +30,6 @@ import qualified Data.Vector.Generic.Mutable as M import qualified Data.Vector.Generic.New as N---- | Safely applies a mutable array algorithm to an immutable array.-apply :: (Vector v e) => (forall s mv. M.MVector mv e => mv s e -> ST s ()) -> v e -> v e-apply algo v = (new . N.New)- (M.unstream (stream v) >>= \arr -> algo arr >> return arr) {- -- | Uses a function to compute a key for each element which the
Data/Vector/Algorithms/Merge.hs view
@@ -14,7 +14,6 @@ module Data.Vector.Algorithms.Merge ( sort , sortBy- , sortByBounds , Comparison ) where @@ -37,8 +36,6 @@ -- | Sorts an array using a custom comparison. sortBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> m ()-sortBy cmp vec = sortByBounds cmp vec 0 (length vec)-{- sortBy cmp vec | len <= 1 = return () | len == 2 = O.sort2ByOffset cmp vec 0@@ -48,84 +45,23 @@ mergeSortWithBuf cmp vec buf where len = length vec--} {-# INLINE sortBy #-} ---- | Sorts a portion of an array [l,u) using a custom comparison.-sortByBounds :: (PrimMonad m, MVector v e)- => Comparison e -> v (PrimState m) e -> Int -> Int -> m ()-sortByBounds cmp vec l u- | len <= 1 = return ()- | len == 2 = O.sort2ByOffset cmp vec l- | len == 3 = O.sort3ByOffset cmp vec l- | len == 4 = O.sort4ByOffset cmp vec l- | otherwise = do tmp <- new size- mergeSortWithBuf cmp vec tmp l u- where- len = u - l- size = (u + l) `div` 2 - l-{-# INLINE sortByBounds #-}- mergeSortWithBuf :: (PrimMonad m, MVector v e)- => Comparison e -> v (PrimState m) e -> v (PrimState m) e- -> Int -> Int -> m ()-mergeSortWithBuf cmp arr tmp = loop+ => Comparison e -> v (PrimState m) e -> v (PrimState m) e -> m ()+mergeSortWithBuf cmp src buf = loop 0 (length src) where loop l u- | len < threshold = I.sortByBounds cmp arr l u+ | len < threshold = I.sortByBounds cmp src l u | otherwise = do loop l mid loop mid u- merge cmp arr tmp l mid u- where- len = u - l- mid = (u + l) `shiftR` 1+ merge cmp (unsafeSlice l len src) buf (mid - l)+ where len = u - l+ mid = (u + l) `shiftR` 1 {-# INLINE mergeSortWithBuf #-} -{--mergeSortWithBuf :: (PrimMonad m, MVector v e)- => Comparison e -> v (PrimState m) e -> v (PrimState m) e -> m ()-mergeSortWithBuf cmp src buf- | length src < threshold = I.sortByBounds cmp src 0 (length src)- | otherwise = do mergeSortWithBuf cmp srcL bufL- mergeSortWithBuf cmp srcU bufU- merge cmp src buf mid- where- len = length src- mid = len `shiftR` 1-- srcL = unsafeSlice 0 mid src- srcU = unsafeSlice mid (len - mid) src- - bufL = unsafeSlice 0 mid buf- bufU = unsafeSlice mid (len - mid) buf--}- merge :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> v (PrimState m) e- -> Int -> Int -> Int -> m ()-merge cmp arr tmp l m u = do copyOffset arr tmp l 0 uTmp- eTmp <- unsafeRead tmp 0- eArr <- unsafeRead arr m- loop 0 eTmp m eArr l- where- uTmp = m - l- uArr = u- loop iTmp eTmp iArr eArr iIns- | iTmp >= uTmp = return ()- | iArr >= uArr = copyOffset tmp arr iTmp iIns (uTmp - iTmp)- | otherwise = case cmp eArr eTmp of- LT -> do unsafeWrite arr iIns eArr- eArr <- unsafeRead arr (iArr+1)- loop iTmp eTmp (iArr+1) eArr (iIns+1)- _ -> do unsafeWrite arr iIns eTmp- eTmp <- unsafeRead tmp (iTmp+1)- loop (iTmp+1) eTmp iArr eArr (iIns+1)-{-# INLINE merge #-}--{--merge :: (PrimMonad m, MVector v e)- => Comparison e -> v (PrimState m) e -> v (PrimState m) e -> Int -> m () merge cmp src buf mid = do unsafeCopy tmp lower eTmp <- unsafeRead tmp 0@@ -148,7 +84,6 @@ eLow <- unsafeRead low (iLow + 1) loop low (iLow + 1) eLow high iHigh eHigh (iIns + 1) {-# INLINE merge #-}--} threshold :: Int threshold = 25
Data/Vector/Algorithms/Search.hs view
@@ -9,7 +9,7 @@ -- Portability : Non-portable (bang patterns) -- -- This module implements several methods of searching for indicies to insert--- elements into a sorted array.+-- elements into a sorted vector. module Data.Vector.Algorithms.Search ( binarySearch@@ -31,58 +31,94 @@ import Data.Vector.Algorithms.Common (Comparison) --- | Finds an index in a givesn sorted array at which the given element could--- be inserted while maintaining the sortedness of the array.+-- | Finds an index in a given sorted vector at which the given element could+-- be inserted while maintaining the sortedness of the vector. binarySearch :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> e -> m Int binarySearch = binarySearchBy compare+{-# INLINE binarySearch #-} --- | Finds an index in a given array, which must be sorted with respect to the+-- | Finds an index in a given vector, which must be sorted with respect to the -- given comparison function, at which the given element could be inserted while--- preserving the array's sortedness.+-- preserving the vector's sortedness. binarySearchBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> e -> m Int-binarySearchBy cmp arr e = binarySearchByBounds cmp arr e 0 (length arr)+binarySearchBy cmp vec e = binarySearchByBounds cmp vec e 0 (length vec)+{-# INLINE binarySearchBy #-} --- | Given an array sorted with respect to a given comparison function in indices+-- | Given a vector sorted with respect to a given comparison function in indices -- in [l,u), finds an index in [l,u] at which the given element could be inserted -- while preserving sortedness. binarySearchByBounds :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int-binarySearchByBounds cmp arr e l u- | u <= l = return l- | otherwise = do e' <- unsafeRead arr k- case cmp e' e of- LT -> binarySearchByBounds cmp arr e (k+1) u- EQ -> return k- GT -> binarySearchByBounds cmp arr e l k- where k = (u + l) `shiftR` 1+binarySearchByBounds cmp vec e = loop+ where+ loop !l !u + | u <= l = return l+ | otherwise = do e' <- unsafeRead vec k+ case cmp e' e of+ LT -> loop (k+1) u+ EQ -> return k+ GT -> loop l k+ where k = (u + l) `shiftR` 1 {-# INLINE binarySearchByBounds #-} --- | Finds the lowest index in a given sorted array at which the given element+-- | Finds the lowest index in a given sorted vector at which the given element -- could be inserted while maintaining the sortedness. binarySearchL :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> e -> m Int binarySearchL = binarySearchLBy compare {-# INLINE binarySearchL #-} --- | Finds the lowest index in a given array, which must be sorted with respect to +-- | Finds the lowest index in a given vector, which must be sorted with respect to -- the given comparison function, at which the given element could be inserted -- while preserving the sortedness. binarySearchLBy :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> e -> m Int-binarySearchLBy cmp arr e = binarySearchLByBounds cmp arr e 0 (length arr)+binarySearchLBy cmp vec e = binarySearchLByBounds cmp vec e 0 (length vec) {-# INLINE binarySearchLBy #-} --- | Given an array sorted with respect to a given comparison function on indices+-- | Given a vector sorted with respect to a given comparison function on indices -- in [l,u), finds the lowest index in [l,u] at which the given element could be -- inserted while preserving sortedness. binarySearchLByBounds :: (PrimMonad m, MVector v e) => Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int-binarySearchLByBounds cmp arr e !l !u- | u <= l = return l- | otherwise = do e' <- unsafeRead arr k- case cmp e' e of- LT -> binarySearchLByBounds cmp arr e (k+1) u- _ -> binarySearchLByBounds cmp arr e l k- where k = (u + l) `shiftR` 1+binarySearchLByBounds cmp vec e = loop+ where+ loop !l !u+ | u <= l = return l+ | otherwise = do e' <- unsafeRead vec k+ case cmp e' e of+ LT -> loop (k+1) u+ _ -> loop l k+ where k = (u + l) `shiftR` 1 {-# INLINE binarySearchLByBounds #-}++-- | Finds the greatest index in a given sorted vector at which the given element+-- could be inserted while maintaining sortedness.+binarySearchR :: (PrimMonad m, MVector v e, Ord e) => v (PrimState m) e -> e -> m Int+binarySearchR = binarySearchRBy compare+{-# INLINE binarySearchR #-}++-- | Finds the greatest index in a given vector, which must be sorted with respect to+-- the given comparison function, at which the given element could be inserted+-- while preserving the sortedness.+binarySearchRBy :: (PrimMonad m, MVector v e)+ => Comparison e -> v (PrimState m) e -> e -> m Int+binarySearchRBy cmp vec e = binarySearchRByBounds cmp vec e 0 (length vec)+{-# INLINE binarySearchRBy #-}++-- | Given a vector sorted with respect to the given comparison function on indices+-- in [l,u), finds the greatest index in [l,u] at which the given element could be+-- inserted while preserving sortedness.+binarySearchRByBounds :: (PrimMonad m, MVector v e)+ => Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int+binarySearchRByBounds cmp vec e = loop+ where+ loop !l !u+ | u <= l = return l+ | otherwise = do e' <- unsafeRead vec k+ case cmp e' e of+ GT -> loop l k+ _ -> loop (k+1) u+ where k = (u + l) `shiftR` 1+{-# INLINE binarySearchRByBounds #-}
tests/Properties.hs view
@@ -22,7 +22,6 @@ import Data.Vector.Algorithms.Optimal (Comparison) import Data.Vector.Algorithms.Radix (radix, passes, size)-import Data.Vector.Algorithms.Combinators import qualified Data.Map as M @@ -157,11 +156,22 @@ where len = V.length arr -prop_search_lowbound :: (Ord e)- => (forall s. MVector s e -> e -> ST s Int)- -> SortedVec e -> e -> Property-prop_search_lowbound algo (Sorted arr) e = property $ (k == 0 || arr V.! (k-1) < e)- && (k == len || arr V.! k >= e)+prop_search_insert :: (e -> e -> Bool) -> (e -> e -> Bool)+ -> (forall s. MVector s e -> e -> ST s Int)+ -> SortedVec e -> e -> Property+prop_search_insert lo hi algo (Sorted arr) e =+ property $ (k == 0 || (arr V.! (k-1)) `lo` e)+ && (k == len || (arr V.! k) `hi` e) where len = V.length arr k = runST (mfromList (V.toList arr) >>= \marr -> algo marr e)++prop_search_lowbound :: (Ord e)+ => (forall s. MVector s e -> e -> ST s Int)+ -> SortedVec e -> e -> Property+prop_search_lowbound = prop_search_insert (<) (>=)++prop_search_upbound :: (Ord e)+ => (forall s. MVector s e -> e -> ST s Int)+ -> SortedVec e -> e -> Property+prop_search_upbound = prop_search_insert (<=) (>)
tests/Tests.hs view
@@ -20,8 +20,6 @@ import Data.Vector.Generic.Mutable (MVector) import qualified Data.Vector.Generic.Mutable as MV -import Data.Vector.Algorithms.Combinators- import qualified Data.Vector.Algorithms.Insertion as INS import qualified Data.Vector.Algorithms.Intro as INT import qualified Data.Vector.Algorithms.Merge as M
vector-algorithms.cabal view
@@ -1,5 +1,5 @@ Name: vector-algorithms-Version: 0.3.4+Version: 0.4 License: BSD3 License-File: LICENSE Author: Dan Doel@@ -26,10 +26,9 @@ Default: False Library- Build-Depends: base >= 3 && < 5, vector >= 0.5 && < 0.8, primitive >=0.2 && <0.4+ Build-Depends: base >= 3 && < 5, vector >= 0.6 && < 0.8, primitive >=0.3 && <0.4 Exposed-Modules:- Data.Vector.Algorithms.Combinators Data.Vector.Algorithms.Optimal Data.Vector.Algorithms.Insertion Data.Vector.Algorithms.Intro