diff --git a/CaseBi.hs b/CaseBi.hs --- a/CaseBi.hs +++ b/CaseBi.hs @@ -1,6 +1,12 @@ +{-# OPTIONS_HADDOCK showe-extensions #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -funbox-strict-fields #-} + -- | -- Module : CaseBi --- Copyright : (c) OleksandrZhabenko 2019 +-- Copyright : (c) OleksandrZhabenko 2019-2021 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com @@ -29,6 +35,7 @@ import qualified Data.Vector as V (Vector,unsafeIndex,unsafeSlice,length,fromList,map) import qualified Data.List as L (groupBy,nubBy) +import GHC.Exts -- | The function that can be used instead of the 'case ... of' function -- @@ -63,13 +70,11 @@ => (b, V.Vector (a, b)) -- ^ @b@ is a default value that can be substituted if there is no correspendence in the set of @(a, b)@ tuples (the 'otherwise' or irrefutable pattern analogue). Vector of the @(a, b)@ tuples that must be sorted in ascending order for the first argument. If there are several pairs @(a, b)@ with the same @a@, the function gives a resulting @b@ as if there is only the first one -> a -- ^ an element for which the corresponding resulting @b@ must be found -> b -- ^ the result -getBFst' (def, vec) l - | if compare l (fst (V.unsafeIndex vec 0)) == LT then True else compare l (fst (V.unsafeIndex vec (V.length vec - 1))) == GT = def - | compare (V.length vec) 2 /= LT = if compare l (fst (V.unsafeIndex vec ((V.length vec `quot` 2) - 1))) /= GT - then getBFst' (def, (V.unsafeSlice 0 (V.length vec `quot` 2) vec)) l - else getBFst' (def, (V.unsafeSlice (V.length vec `quot` 2) (V.length vec - (V.length vec `quot` 2)) vec)) l - | otherwise = snd (V.unsafeIndex vec 0) -{-# INLINABLE getBFst' #-} +getBFst' (def, vec) = getBFst'' (# 0, k #) (# j, m #) vec def + where !j = V.length vec - 1 + !k = V.unsafeIndex vec 0 + !m = V.unsafeIndex vec j +{-# INLINE getBFst' #-} -- | The function that uses special realization of the binary search to effectively transform the 'V.Vector' @a@ to 'V.Vector' @b@ instead of simply use -- @@ -176,3 +181,42 @@ -- filterP p xs = V.fromList . concatMap (\x -> take 1 . dropWhile (not . p) $ x) . L.groupBy (\(x1,_) (x2,_) -> x1 == x2) $ xs {-# INLINE filterP #-} + +{- | The function that can be used instead of the 'case ... of' function +@ +case var of { a1 -> b1 ; a2 -> b2 ; a3 -> b3 ; ... ; an -> bn ; ~z -> defaultValue } +@ +If we follow a lot of teaching materials that explain the workflow of the construction +we think that the complexity of it is about /O(n)/ for the transformation of @a@ to @b@ here. +David Feuer (david.feuer (at) gmail.com) said that 'case ... of' is already optimized in GHC. +Some benchmarks show that its behaviour tends to be about of /O(log n)/ complexity, the same as +the proposed function 'getBFst''. Nevertheless, the last one shows better performance in some situations, +is rather general and can be used for another data representation. Therefore, it can be preferred in +some situations. 'getBFst'' uses binary search algorithm and an 'V.Vector' of @(a, b)@ as somewhat like a complicated filter or like a special sieve. The 'V.Vector' must be sorted in ascending order here for the algorithm to be used correctly. For this you can use the function 'sortFstV' or the similar ones. +-} +getBFst'' + :: Ord a => (# Int, (a, b) #) -- ^ The first unboxed tuple of the index and the element of the array. + -> (# Int, (a, b) #) -- ^ The second unboxed tuple of the index and the element of the array. + -> V.Vector (a, b) -- ^ The array of the pairs of the compared value and the result that is used in case the last argument is equal to the compared value. + -> b -- ^ The default value that is used if no first element in the array tuples equals to the compared value. + -> a -- ^ The compared value, well, the @main@ function argument, to which it is applied. + -> b -- ^ The resulting branch value. +getBFst'' (# (I# i#), k #) (# (I# j#), m #) vec def x + | if x < fst k then True else x > fst m = def + | otherwise = gBF3 (# i# , k #) (# j# , m #) vec def x +{-# INLINE getBFst'' #-} + +-- | The meaning of the arguments is the same as for 'getBFst'''. Is used internally in it. +gBF3 :: Ord a => (# Int#, (a, b) #) -> (# Int#, (a, b) #) -> V.Vector (a, b) -> b -> a -> b +gBF3 (# !i#, k #) (# !j#, m #) vec def x + | isTrue# ((j# -# i#) ># 1# ) = + case compare x (fst p) of + GT -> gBF3 (# n#, p #) (# j#, m #) vec def x + LT -> gBF3 (# i#, k #) (# n#, p #) vec def x + _ -> snd p + | x == fst m = snd m + | x == fst k = snd k + | otherwise = def + where !n# = (i# +# j#) `quotInt#` 2# + !p = V.unsafeIndex vec (I# n#) +{-# INLINABLE gBF3 #-} diff --git a/CaseBi/Unboxed.hs b/CaseBi/Unboxed.hs --- a/CaseBi/Unboxed.hs +++ b/CaseBi/Unboxed.hs @@ -1,6 +1,12 @@ +{-# OPTIONS_HADDOCK showe-extensions #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE UnboxedTuples #-} +{-# OPTIONS_GHC -funbox-strict-fields #-} + -- | -- Module : CaseBi.Unboxed --- Copyright : (c) OleksandrZhabenko 2019-2020 +-- Copyright : (c) OleksandrZhabenko 2019-2021 -- License : MIT -- Stability : Experimental -- Maintainer : olexandr543@yahoo.com @@ -28,6 +34,7 @@ import qualified Data.Vector.Unboxed as V (Vector,unsafeIndex,unsafeSlice,length,fromList,map) import qualified Data.List as L (groupBy,nubBy) import Data.Vector.Unboxed.Base +import GHC.Exts -- | A variant of the 'CaseBi.getBFst'' function that operates on the unboxed 'V.Vector'. -- @@ -36,12 +43,11 @@ => (b, V.Vector (a, b)) -- ^ @b@ is a default value that can be substituted if there is no correspendence in the set of @(a, b)@ tuples (the 'otherwise' or irrefutable pattern analogue). Vector of the @(a, b)@ tuples that must be sorted in ascending order for the first argument. If there are several pairs @(a, b)@ with the same @a@, the function gives a resulting @b@ as if there is only the first one -> a -- ^ an element for which the corresponding resulting b must be found -> b -- ^ the result -getBFst' (def, vec) l | if compare l (fst (V.unsafeIndex vec 0)) == LT then True else compare l (fst (V.unsafeIndex vec (V.length vec - 1))) == GT = def - | compare (V.length vec) 2 /= LT = if compare l (fst (V.unsafeIndex vec ((V.length vec `quot` 2) - 1))) /= GT - then getBFst' (def, (V.unsafeSlice 0 (V.length vec `quot` 2) vec)) l - else getBFst' (def, (V.unsafeSlice (V.length vec `quot` 2) (V.length vec - (V.length vec `quot` 2)) vec)) l - | otherwise = snd (V.unsafeIndex vec 0) -{-# INLINABLE getBFst' #-} +getBFst' (def, vec) = getBFst'' (# 0, k #) (# j, m #) vec def + where !j = V.length vec - 1 + !k = V.unsafeIndex vec 0 + !m = V.unsafeIndex vec j +{-# INLINE getBFst' #-} -- | A variant of the 'CaseBi.getBFstV' that operates on the unboxed 'V.Vector'. -- @@ -63,8 +69,10 @@ -- | A variant of the 'CaseBi.sortFst' that operates on the unboxed 'V.Vector'. It is inspired by the work: https://wiki.haskell.org/Introduction sortFst :: (Ord a, Unbox a, Unbox b) => [(a, b)] -> [(a, b)] -sortFst xs = if null xs then [] else sortFst (filter (\(x, _) -> compare x (fst (head xs)) == LT) xs) ++ filter (\(x, _) -> x == (fst (head xs))) xs ++ - sortFst (filter (\(x, _) -> compare x (fst (head xs)) == GT) xs) +sortFst xs + | null xs = [] + | otherwise = sortFst (filter (\(x, _) -> x < fst (head xs)) xs) ++ filter (\(x, _) -> x == (fst (head xs))) xs ++ + sortFst (filter (\(x, _) -> x > fst (head xs)) xs) {-# INLINABLE sortFst #-} -- | A variant of the 'CaseBi.sortFstV' that operates on the unboxed 'V.Vector'. @@ -85,3 +93,43 @@ -- filterP p xs = V.fromList . concatMap (\x -> take 1 . dropWhile (not . p) $ x) . L.groupBy (\(x1,_) (x2,_) -> x1 == x2) $ xs {-# INLINE filterP #-} + + +{- | The function that can be used instead of the 'case ... of' function +@ +case var of { a1 -> b1 ; a2 -> b2 ; a3 -> b3 ; ... ; an -> bn ; ~z -> defaultValue } +@ +If we follow a lot of teaching materials that explain the workflow of the construction +we think that the complexity of it is about /O(n)/ for the transformation of @a@ to @b@ here. +David Feuer (david.feuer (at) gmail.com) said that 'case ... of' is already optimized in GHC. +Some benchmarks show that its behaviour tends to be about of /O(log n)/ complexity, the same as +the proposed function 'getBFst''. Nevertheless, the last one shows better performance in some situations, +is rather general and can be used for another data representation. Therefore, it can be preferred in +some situations. 'getBFst'' uses binary search algorithm and an 'V.Vector' of @(a, b)@ as somewhat like a complicated filter or like a special sieve. The 'V.Vector' must be sorted in ascending order here for the algorithm to be used correctly. For this you can use the function 'sortFstV' or the similar ones. +-} +getBFst'' + :: (Ord a, Unbox a, Unbox b) => (# Int, (a, b) #) -- ^ The first unboxed tuple of the index and the element of the array. + -> (# Int, (a, b) #) -- ^ The second unboxed tuple of the index and the element of the array. + -> V.Vector (a, b) -- ^ The array of the pairs of the compared value and the result that is used in case the last argument is equal to the compared value. + -> b -- ^ The default value that is used if no first element in the array tuples equals to the compared value. + -> a -- ^ The compared value, well, the @main@ function argument, to which it is applied. + -> b -- ^ The resulting branch value. +getBFst'' (# (I# i#), k #) (# (I# j#), m #) vec def x + | if x < fst k then True else x > fst m = def + | otherwise = gBF3 (# i# , k #) (# j# , m #) vec def x +{-# INLINE getBFst'' #-} + +-- | The meaning of the arguments is the same as for 'getBFst'''. Is used internally in it. +gBF3 :: (Ord a, Unbox a, Unbox b) => (# Int#, (a, b) #) -> (# Int#, (a, b) #) -> V.Vector (a, b) -> b -> a -> b +gBF3 (# !i#, k #) (# !j#, m #) vec def x + | isTrue# ((j# -# i#) ># 1# ) = + case compare x (fst p) of + GT -> gBF3 (# n#, p #) (# j#, m #) vec def x + LT -> gBF3 (# i#, k #) (# n#, p #) vec def x + _ -> snd p + | x == fst m = snd m + | x == fst k = snd k + | otherwise = def + where !n# = (i# +# j#) `quotInt#` 2# + !p = V.unsafeIndex vec (I# n#) +{-# INLINABLE gBF3 #-} diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -48,3 +48,7 @@ * Third version revised A. Changed inlining policies for self-recursive functions to be {-# INLINABLE #-}. +## 0.3.2.0 -- 2021-03-29 + +* Third version revised B. Some performance optimization improvements. Added GHC.Exts module as import and the usage of +several language extensions. diff --git a/mmsyn2.cabal b/mmsyn2.cabal --- a/mmsyn2.cabal +++ b/mmsyn2.cabal @@ -2,7 +2,7 @@ -- see http://haskell.org/cabal/users-guide/ name: mmsyn2 -version: 0.3.1.0 +version: 0.3.2.0 synopsis: The library that can be used for multiple (Ord a) => a -> b transformations description: The library that can be used for optimization or another representation of multiple (Ord a) => a -> b transformations homepage: https://oleksandrzhabenko.github.io/mmsyn2 @@ -19,8 +19,9 @@ library exposed-modules: CaseBi, CaseBi.Unboxed -- other-modules: - -- other-extensions: - build-depends: base >=4.3 && <4.15, vector >=0.11 && <0.14 + other-extensions: BangPatterns, MagicHash, UnboxedTuples + ghc-options: -funbox-strict-fields + build-depends: base >=4.7 && <4.15, vector >=0.11 && <0.14 -- hs-source-dirs: default-language: Haskell2010 -- optimization: 2