diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +## Text Metrics 0.3.3 + +* Slightly optimized the `levenshtein` and `levenshteinNorm` functions. [PR + 50](https://github.com/mrkkrp/text-metrics/pull/50). + ## Text Metrics 0.3.2 * Works with `text-2.0`. diff --git a/Data/Text/Metrics.hs b/Data/Text/Metrics.hs --- a/Data/Text/Metrics.hs +++ b/Data/Text/Metrics.hs @@ -39,13 +39,14 @@ import Control.Monad import Control.Monad.ST import Data.Map.Strict (Map) -import qualified Data.Map.Strict as M +import Data.Map.Strict qualified as M +import Data.Primitive qualified as P import Data.Ratio import Data.Text -import qualified Data.Text as T -import qualified Data.Text.Internal as T -import qualified Data.Text.Unsafe as TU -import qualified Data.Vector.Unboxed.Mutable as VUM +import Data.Text qualified as T +import Data.Text.Internal qualified as T +import Data.Text.Unsafe qualified as TU +import Data.Vector.Unboxed.Mutable qualified as VUM import GHC.Exts (inline) ---------------------------------------------------------------------------- @@ -85,29 +86,34 @@ | T.null b = (lena, lenm) | otherwise = runST $ do let v_len = lenb + 1 - v <- VUM.unsafeNew (v_len * 2) + v <- P.newPrimArray (v_len * 2) let gov !i = when (i < v_len) $ do - VUM.unsafeWrite v i i + P.writePrimArray v i i gov (i + 1) goi !i !na !v0 !v1 = do let !(TU.Iter ai da) = TU.iter a na goj !j !nb = when (j < lenb) $ do let !(TU.Iter bj db) = TU.iter b nb - cost = if ai == bj then 0 else 1 - x <- (+ 1) <$> VUM.unsafeRead v (v1 + j) - y <- (+ 1) <$> VUM.unsafeRead v (v0 + j + 1) - z <- (+ cost) <$> VUM.unsafeRead v (v0 + j) - VUM.unsafeWrite v (v1 + j + 1) (min x (min y z)) - goj (j + 1) (nb + db) + if ai == bj + then do + z <- P.readPrimArray v (v0 + j) + P.writePrimArray v (v1 + j + 1) z + goj (j + 1) (nb + db) + else do + x <- P.readPrimArray v (v1 + j) + y <- P.readPrimArray v (v0 + j + 1) + z <- P.readPrimArray v (v0 + j) + P.writePrimArray v (v1 + j + 1) (1 + (min x (min y z))) + goj (j + 1) (nb + db) when (i < lena) $ do - VUM.unsafeWrite v v1 (i + 1) + P.writePrimArray v v1 (i + 1) goj 0 0 goi (i + 1) (na + da) v1 v0 gov 0 goi 0 0 0 v_len - ld <- VUM.unsafeRead v (lenb + if even lena then 0 else v_len) + ld <- P.readPrimArray v (lenb + if even lena then 0 else v_len) return (ld, lenm) where lena = T.length a @@ -256,9 +262,9 @@ let !(TU.Iter cha da) = TU.iter a na !(TU.Iter chb db) = TU.iter b nb in if - | na == len -> r - | cha /= chb -> go (na + da) (nb + db) (r + 1) - | otherwise -> go (na + da) (nb + db) r + | na == len -> r + | cha /= chb -> go (na + da) (nb + db) (r + 1) + | otherwise -> go (na + da) (nb + db) r -- | Return the Jaro distance between two 'Text' values. Returned value is -- in the range from 0 (no similarity) to 1 (exact match). diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,6 +0,0 @@ -module Main (main) where - -import Distribution.Simple - -main :: IO () -main = defaultMain diff --git a/bench/memory/Main.hs b/bench/memory/Main.hs --- a/bench/memory/Main.hs +++ b/bench/memory/Main.hs @@ -3,7 +3,7 @@ import Control.DeepSeq import Control.Monad import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Data.Text.Metrics import Weigh @@ -22,7 +22,7 @@ -- | Perform a series to measurements with the same metric function. bmetric :: - NFData a => + (NFData a) => -- | Name of the benchmark group String -> -- | The function to benchmark diff --git a/bench/speed/Main.hs b/bench/speed/Main.hs --- a/bench/speed/Main.hs +++ b/bench/speed/Main.hs @@ -3,7 +3,7 @@ import Control.DeepSeq import Criterion.Main import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Data.Text.Metrics main :: IO () @@ -21,7 +21,7 @@ ] -- | Produce benchmark group to test. -btmetric :: NFData a => String -> (Text -> Text -> a) -> Benchmark +btmetric :: (NFData a) => String -> (Text -> Text -> a) -> Benchmark btmetric name f = bgroup name (bs <$> stdSeries) where bs n = env (return (testData n, testData n)) (bench (show n) . nf (uncurry f)) diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -5,7 +5,7 @@ import Data.Ratio import Data.Text (Text) -import qualified Data.Text as T +import Data.Text qualified as T import Data.Text.Metrics import Test.Hspec import Test.QuickCheck diff --git a/text-metrics.cabal b/text-metrics.cabal --- a/text-metrics.cabal +++ b/text-metrics.cabal @@ -1,11 +1,11 @@ cabal-version: 2.4 name: text-metrics -version: 0.3.2 +version: 0.3.3 license: BSD-3-Clause license-file: LICENSE.md maintainer: Mark Karpov author: Mark Karpov -tested-with: ghc ==8.10.7 ghc ==9.0.1 ghc ==9.2.1 +tested-with: ghc ==9.6.3 ghc ==9.8.2 ghc ==9.10.1 homepage: https://github.com/mrkkrp/text-metrics bug-reports: https://github.com/mrkkrp/text-metrics/issues synopsis: Calculate various string metrics efficiently @@ -27,15 +27,18 @@ library exposed-modules: Data.Text.Metrics - default-language: Haskell2010 + default-language: GHC2021 build-depends: - base >=4.13 && <5.0, - containers >=0.5 && <0.7, - text >=0.2 && <2.1, - vector >=0.11 && <0.13 + base >=4.15 && <5, + containers >=0.5 && <0.8, + text >=0.2 && <2.2, + vector >=0.11 && <0.14, + primitive >=0.9 && <0.10 if flag(dev) - ghc-options: -Wall -Werror + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages else ghc-options: -O2 -Wall @@ -44,39 +47,38 @@ type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: tests - default-language: Haskell2010 + default-language: GHC2021 build-depends: - QuickCheck >=2.8 && <3.0, - base >=4.13 && <5.0, - hspec >=2.0 && <3.0, - text >=0.2 && <2.1, + QuickCheck >=2.8 && <3, + base >=4.15 && <5, + hspec >=2.0 && <3, + text >=0.2 && <2.2, text-metrics if flag(dev) - ghc-options: -Wall -Werror + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages else ghc-options: -O2 -Wall - if flag(dev) - ghc-options: - -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns - -Wnoncanonical-monad-instances - benchmark bench-speed type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bench/speed - default-language: Haskell2010 + default-language: GHC2021 build-depends: - base >=4.13 && <5.0, - criterion >=0.6.2.1 && <1.6, - deepseq >=1.3 && <1.5, - text >=0.2 && <2.1, + base >=4.15 && <5, + criterion >=0.6.2.1 && <1.7, + deepseq >=1.3 && <1.6, + text >=0.2 && <2.2, text-metrics if flag(dev) - ghc-options: -O2 -Wall -Werror + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages else ghc-options: -O2 -Wall @@ -85,16 +87,18 @@ type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bench/memory - default-language: Haskell2010 + default-language: GHC2021 build-depends: - base >=4.13 && <5.0, - deepseq >=1.3 && <1.5, - text >=0.2 && <2.1, + base >=4.15 && <5, + deepseq >=1.3 && <1.6, + text >=0.2 && <2.2, text-metrics, weigh >=0.0.4 if flag(dev) - ghc-options: -O2 -Wall -Werror + ghc-options: + -Wall -Werror -Wredundant-constraints -Wpartial-fields + -Wunused-packages else ghc-options: -O2 -Wall