text-metrics 0.3.0 → 0.3.3
raw patch · 11 files changed
Files
- CHANGELOG.md +17/−0
- Data/Text/Metrics.hs +77/−93
- LICENSE.md +1/−1
- README.md +15/−6
- Setup.hs +0/−6
- bench-memory/Main.hs +0/−38
- bench-speed/Main.hs +0/−34
- bench/memory/Main.hs +39/−0
- bench/speed/Main.hs +34/−0
- tests/Main.hs +97/−113
- text-metrics.cabal +92/−70
CHANGELOG.md view
@@ -1,3 +1,20 @@+## 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`.++## Text Metrics 0.3.1++* Fixed a bug in the implementation of Jaro-Winkler distance when two+ strings share a long prefix. [PR+ 21](https://github.com/mrkkrp/text-metrics/pull/21).++* Dropped support for GHC 8.6 and older.+ ## Text Metrics 0.3.0 * All functions are now implemented in pure Haskell.
Data/Text/Metrics.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiWayIf #-}+ -- | -- Module : Data.Text.Metrics--- Copyright : © 2016–2017 Mark Karpov+-- Copyright : © 2016–present Mark Karpov -- License : BSD 3 clause -- -- Maintainer : Mark Karpov <markkarpov92@gmail.com>@@ -15,47 +18,43 @@ -- implementations are written in Haskell while staying almost as fast, see: -- -- <https://markkarpov.com/post/migrating-text-metrics.html>--{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE MultiWayIf #-}- module Data.Text.Metrics ( -- * Levenshtein variants- levenshtein- , levenshteinNorm- , damerauLevenshtein- , damerauLevenshteinNorm+ levenshtein,+ levenshteinNorm,+ damerauLevenshtein,+ damerauLevenshteinNorm,+ -- * Treating inputs like sets- , overlap- , jaccard+ overlap,+ jaccard,+ -- * Other- , hamming- , jaro- , jaroWinkler )+ hamming,+ jaro,+ jaroWinkler,+ ) where import Control.Monad import Control.Monad.ST import Data.Map.Strict (Map)+import Data.Map.Strict qualified as M+import Data.Primitive qualified as P import Data.Ratio import Data.Text+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)-import qualified Data.Map.Strict as M-import qualified Data.Text as T-import qualified Data.Text.Unsafe as TU-import qualified Data.Vector.Unboxed.Mutable as VUM -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- ---------------------------------------------------------------------------- -- Levenshtein variants --- | Return Levenshtein distance between two 'Text' values. Classic+-- | Return the Levenshtein distance between two 'Text' values. The -- Levenshtein distance between two strings is the minimal number of--- operations necessary to transform one string into another. For+-- operations necessary to transform one string into another. For the -- Levenshtein distance allowed operations are: deletion, insertion, and -- substitution. --@@ -63,11 +62,10 @@ -- -- __Heads up__, before version /0.3.0/ this function returned -- 'Data.Numeric.Natural'.- levenshtein :: Text -> Text -> Int levenshtein a b = fst (levenshtein_ a b) --- | Return normalized Levenshtein distance between two 'Text' values.+-- | Return the normalized Levenshtein distance between two 'Text' values. -- Result is a non-negative rational number (represented as @'Ratio' -- 'Data.Numeric.Natural'@), where 0 signifies no similarity between the -- strings, while 1 means exact match.@@ -76,43 +74,46 @@ -- -- __Heads up__, before version /0.3.0/ this function returned @'Ratio' -- 'Data.Numeric.Natural'@.- levenshteinNorm :: Text -> Text -> Ratio Int levenshteinNorm = norm levenshtein_ --- | An internal helper, returns Levenshtein distance as the first element--- of the tuple and max length of the two inputs as the second element of--- the tuple.-+-- | An internal helper, returns the Levenshtein distance as the first+-- element of the tuple and max length of the two inputs as the second+-- element of the tuple. levenshtein_ :: Text -> Text -> (Int, Int) levenshtein_ a b | T.null a = (lenb, lenm) | 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@@ -120,7 +121,7 @@ lenm = max lena lenb {-# INLINE levenshtein_ #-} --- | Return Damerau-Levenshtein distance between two 'Text' values. The+-- | Return the Damerau-Levenshtein distance between two 'Text' values. The -- function works like 'levenshtein', but the collection of allowed -- operations also includes transposition of two /adjacent/ characters. --@@ -128,11 +129,10 @@ -- -- __Heads up__, before version /0.3.0/ this function returned -- 'Data.Numeric.Natural'.- damerauLevenshtein :: Text -> Text -> Int damerauLevenshtein a b = fst (damerauLevenshtein_ a b) --- | Return normalized Damerau-Levenshtein distance between two 'Text'+-- | Return the normalized Damerau-Levenshtein distance between two 'Text' -- values. 0 signifies no similarity between the strings, while 1 means -- exact match. --@@ -140,14 +140,12 @@ -- -- __Heads up__, before version /0.3.0/ this function returned @'Ratio' -- 'Data.Numeric.Natural'@.- damerauLevenshteinNorm :: Text -> Text -> Ratio Int damerauLevenshteinNorm = norm damerauLevenshtein_ --- | An internal helper, returns Damerau-Levenshtein distance as the first--- element of the tuple and max length of the two inputs as the second+-- | An internal helper, returns the Damerau-Levenshtein distance as the+-- first element of the tuple and max length of the two inputs as the second -- element of the tuple.- damerauLevenshtein_ :: Text -> Text -> (Int, Int) damerauLevenshtein_ a b | T.null a = (lenb, lenm)@@ -192,14 +190,13 @@ ---------------------------------------------------------------------------- -- Treating inputs like sets --- | Return overlap coefficient for two 'Text' values. Returned value is in--- the range from 0 (no similarity) to 1 (exact match). Return 1 if both+-- | Return the overlap coefficient for two 'Text' values. Returned value is+-- in the range from 0 (no similarity) to 1 (exact match). Return 1 if both -- 'Text' values are empty. -- -- See also: <https://en.wikipedia.org/wiki/Overlap_coefficient>. -- -- @since 0.3.0- overlap :: Text -> Text -> Ratio Int overlap a b = if d == 0@@ -208,14 +205,13 @@ where d = min (T.length a) (T.length b) --- | Return Jaccard similarity coefficient for two 'Text' values. Returned--- value is in the range from 0 (no similarity) to 1 (exact match). Return 1--- if both+-- | Return the Jaccard similarity coefficient for two 'Text' values.+-- Returned value is in the range from 0 (no similarity) to 1 (exact match).+-- Return 1 if both -- -- See also: <https://en.wikipedia.org/wiki/Jaccard_index> -- -- @since 0.3.0- jaccard :: Text -> Text -> Ratio Int jaccard a b = if d == 0@@ -224,11 +220,10 @@ where ma = mkTextMap a mb = mkTextMap b- d = unionSize ma mb+ d = unionSize ma mb -- | Make a map from 'Char' to 'Int' representing how many times the 'Char' -- appears in the input 'Text'.- mkTextMap :: Text -> Map Char Int mkTextMap = T.foldl' f M.empty where@@ -236,13 +231,11 @@ {-# INLINE mkTextMap #-} -- | Return intersection size between two 'Text'-maps.- intersectionSize :: Map Char Int -> Map Char Int -> Int intersectionSize a b = M.foldl' (+) 0 (M.intersectionWith min a b) {-# INLINE intersectionSize #-} -- | Return union size between two 'Text'-maps.- unionSize :: Map Char Int -> Map Char Int -> Int unionSize a b = M.foldl' (+) 0 (M.unionWith max a b) {-# INLINE unionSize #-}@@ -250,7 +243,7 @@ ---------------------------------------------------------------------------- -- Other --- | /O(n)/ Return Hamming distance between two 'Text' values. Hamming+-- | /O(n)/ Return the Hamming distance between two 'Text' values. Hamming -- distance is defined as the number of positions at which the corresponding -- symbols are different. The input 'Text' values should be of equal length -- or 'Nothing' will be returned.@@ -259,9 +252,8 @@ -- -- __Heads up__, before version /0.3.0/ this function returned @'Maybe' -- 'Data.Numeric.Natural'@.- hamming :: Text -> Text -> Maybe Int-hamming a b =+hamming a@(T.Text _ _ len) b = if T.length a == T.length b then Just (go 0 0 0) else Nothing@@ -269,13 +261,13 @@ go !na !nb !r = let !(TU.Iter cha da) = TU.iter a na !(TU.Iter chb db) = TU.iter b nb- in if | na == len -> r+ in if+ | na == len -> r | cha /= chb -> go (na + da) (nb + db) (r + 1)- | otherwise -> go (na + da) (nb + db) r- len = TU.lengthWord16 a+ | otherwise -> go (na + da) (nb + db) r --- | Return Jaro distance between two 'Text' values. Returned value is in--- the range from 0 (no similarity) to 1 (exact match).+-- | Return the Jaro distance between two 'Text' values. Returned value is+-- in the range from 0 (no similarity) to 1 (exact match). -- -- While the algorithm is pretty clear for artificial examples (like those -- from the linked Wikipedia article), for /arbitrary/ strings, it may be@@ -296,7 +288,6 @@ -- -- __Heads up__, before version /0.3.0/ this function returned @'Ratio' -- 'Data.Numeric.Natural'@.- jaro :: Text -> Text -> Ratio Int jaro a b = if T.null a || T.null b@@ -326,7 +317,7 @@ tj <- VUM.unsafeRead r 0 if j < tj then VUM.unsafeModify r (+ 1) 2- else VUM.unsafeWrite r 0 j+ else VUM.unsafeWrite r 0 j VUM.unsafeWrite v j 1 VUM.unsafeModify r (+ 1) 1 else goj (j + 1) (nb + db)@@ -339,12 +330,15 @@ return $ if m == 0 then 0 % 1- else ((m % lena) +- (m % lenb) +- ((m - t) % m)) / 3+ else+ ( (m % lena)+ + (m % lenb)+ + ((m - t) % m)+ )+ / 3 --- | Return Jaro-Winkler distance between two 'Text' values. Returned value--- is in range from 0 (no similarity) to 1 (exact match).+-- | Return the Jaro-Winkler distance between two 'Text' values. Returned+-- value is in range from 0 (no similarity) to 1 (exact match). -- -- See also: <https://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance> --@@ -352,27 +346,17 @@ -- -- __Heads up__, before version /0.3.0/ this function returned @'Ratio' -- 'Data.Numeric.Natural'@.- jaroWinkler :: Text -> Text -> Ratio Int jaroWinkler a b = dj + (1 % 10) * l * (1 - dj) where dj = inline (jaro a b)- l = fromIntegral (commonPrefix a b)---- | Return length of common prefix two 'Text' values have.+ l = fromIntegral (min 4 (commonPrefix a b)) +-- | Return the length of the common prefix two 'Text' values have. commonPrefix :: Text -> Text -> Int-commonPrefix a b = go 0 0 0- where- go !na !nb !r =- let !(TU.Iter cha da) = TU.iter a na- !(TU.Iter chb db) = TU.iter b nb- in if | na == lena -> r- | nb == lenb -> r- | cha == chb -> go (na + da) (nb + db) (r + 1)- | otherwise -> r- lena = TU.lengthWord16 a- lenb = TU.lengthWord16 b+commonPrefix a b = case T.commonPrefixes a b of+ Nothing -> 0+ Just (pref, _, _) -> T.length pref {-# INLINE commonPrefix #-} ----------------------------------------------------------------------------@@ -381,7 +365,7 @@ norm :: (Text -> Text -> (Int, Int)) -> Text -> Text -> Ratio Int norm f a b = let (r, l) = f a b- in if r == 0- then 1 % 1- else 1 % 1 - r % l+ in if r == 0+ then 1 % 1+ else 1 % 1 - r % l {-# INLINE norm #-}
LICENSE.md view
@@ -1,4 +1,4 @@-Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov All rights reserved.
README.md view
@@ -4,8 +4,7 @@ [](https://hackage.haskell.org/package/text-metrics) [](http://stackage.org/nightly/package/text-metrics) [](http://stackage.org/lts/package/text-metrics)-[](https://travis-ci.org/mrkkrp/text-metrics)-[](https://coveralls.io/github/mrkkrp/text-metrics?branch=master)+ The library provides efficient implementations of various strings metric algorithms. It works with strict `Text` values.@@ -24,8 +23,9 @@ ## Comparison with the `edit-distance` package -There is [`edit-distance`](https://hackage.haskell.org/package/edit-distance) package whose scope overlaps with the scope of-this package. The differences are:+There is+[`edit-distance`](https://hackage.haskell.org/package/edit-distance) package+whose scope overlaps with the scope of this package. The differences are: * `edit-distance` allows to specify costs for every operation when calculating Levenshtein distance (insertion, deletion, substitution, and@@ -41,10 +41,19 @@ ## Implementation Although we originally used C for speed, currently all functions are pure-Haskell tuned for performance. See [this blog post](https://markkarpov.com/post/migrating-text-metrics.html) for more info.+Haskell tuned for performance. See [this blog+post](https://markkarpov.com/post/migrating-text-metrics.html) for more+info. +## Contribution++Issues, bugs, and questions may be reported in [the GitHub issue tracker for+this project](https://github.com/mrkkrp/text-metrics/issues).++Pull requests are also welcome.+ ## License -Copyright © 2016–2017 Mark Karpov+Copyright © 2016–present Mark Karpov Distributed under BSD 3 clause license.
− Setup.hs
@@ -1,6 +0,0 @@-module Main (main) where--import Distribution.Simple--main :: IO ()-main = defaultMain
− bench-memory/Main.hs
@@ -1,38 +0,0 @@-module Main (main) where--import Control.DeepSeq-import Control.Monad-import Data.Text (Text)-import Data.Text.Metrics-import Weigh-import qualified Data.Text as T--main :: IO ()-main = mainWith $ do- setColumns [Case, Allocated, GCs, Max]- bmetric "levenshtein" levenshtein- bmetric "levenshteinNorm" levenshteinNorm- bmetric "damerauLevenshtein" damerauLevenshtein- bmetric "damerauLevenshteinNorm" damerauLevenshteinNorm- bmetric "overlap" overlap- bmetric "jaccard" jaccard- bmetric "hamming" hamming- bmetric "jaro" jaro- bmetric "jaroWinkler" jaroWinkler---- | Perform a series to measurements with the same metric function.--bmetric :: NFData a- => String -- ^ Name of the benchmark group- -> (Text -> Text -> a) -- ^ The function to benchmark- -> Weigh ()-bmetric name f = forM_ stdSeries $ \n ->- func (name ++ "/" ++ show n) (uncurry f) (testData n, testData n)---- | The series of lengths to try with every function as part of 'btmetric'.--stdSeries :: [Int]-stdSeries = [5,10,20,40,80,160]--testData :: Int -> Text-testData n = T.pack . take n . drop (n `mod` 4) . cycle $ ['a'..'z']
− bench-speed/Main.hs
@@ -1,34 +0,0 @@-module Main (main) where--import Control.DeepSeq-import Criterion.Main-import Data.Text (Text)-import Data.Text.Metrics-import qualified Data.Text as T--main :: IO ()-main = defaultMain- [ btmetric "levenshtein" levenshtein- , btmetric "levenshteinNorm" levenshteinNorm- , btmetric "damerauLevenshtein" damerauLevenshtein- , btmetric "damerauLevenshteinNorm" damerauLevenshteinNorm- , btmetric "overlap" overlap- , btmetric "jaccard" jaccard- , btmetric "hamming" hamming- , btmetric "jaro" jaro- , btmetric "jaroWinkler" jaroWinkler ]---- | Produce benchmark group to test.--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))---- | The series of lengths to try with every function as part of 'btmetric'.--stdSeries :: [Int]-stdSeries = [5,10,20,40,80,160]--testData :: Int -> Text-testData n = T.pack . take n . drop (n `mod` 4) . cycle $ ['a'..'z']
+ bench/memory/Main.hs view
@@ -0,0 +1,39 @@+module Main (main) where++import Control.DeepSeq+import Control.Monad+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Metrics+import Weigh++main :: IO ()+main = mainWith $ do+ setColumns [Case, Allocated, GCs, Max]+ bmetric "levenshtein" levenshtein+ bmetric "levenshteinNorm" levenshteinNorm+ bmetric "damerauLevenshtein" damerauLevenshtein+ bmetric "damerauLevenshteinNorm" damerauLevenshteinNorm+ bmetric "overlap" overlap+ bmetric "jaccard" jaccard+ bmetric "hamming" hamming+ bmetric "jaro" jaro+ bmetric "jaroWinkler" jaroWinkler++-- | Perform a series to measurements with the same metric function.+bmetric ::+ (NFData a) =>+ -- | Name of the benchmark group+ String ->+ -- | The function to benchmark+ (Text -> Text -> a) ->+ Weigh ()+bmetric name f = forM_ stdSeries $ \n ->+ func (name ++ "/" ++ show n) (uncurry f) (testData n, testData n)++-- | The series of lengths to try with every function as part of 'btmetric'.+stdSeries :: [Int]+stdSeries = [5, 10, 20, 40, 80, 160]++testData :: Int -> Text+testData n = T.pack . take n . drop (n `mod` 4) . cycle $ ['a' .. 'z']
+ bench/speed/Main.hs view
@@ -0,0 +1,34 @@+module Main (main) where++import Control.DeepSeq+import Criterion.Main+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Metrics++main :: IO ()+main =+ defaultMain+ [ btmetric "levenshtein" levenshtein,+ btmetric "levenshteinNorm" levenshteinNorm,+ btmetric "damerauLevenshtein" damerauLevenshtein,+ btmetric "damerauLevenshteinNorm" damerauLevenshteinNorm,+ btmetric "overlap" overlap,+ btmetric "jaccard" jaccard,+ btmetric "hamming" hamming,+ btmetric "jaro" jaro,+ btmetric "jaroWinkler" jaroWinkler+ ]++-- | Produce benchmark group to test.+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))++-- | The series of lengths to try with every function as part of 'btmetric'.+stdSeries :: [Int]+stdSeries = [5, 10, 20, 40, 80, 160]++testData :: Int -> Text+testData n = T.pack . take n . drop (n `mod` 4) . cycle $ ['a' .. 'z']
tests/Main.hs view
@@ -1,20 +1,15 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Data.Ratio import Data.Text (Text)+import Data.Text qualified as T import Data.Text.Metrics import Test.Hspec import Test.QuickCheck-import qualified Data.Text as T -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative-#endif- instance Arbitrary Text where arbitrary = T.pack <$> arbitrary @@ -26,140 +21,129 @@ describe "levenshtein" $ do testSwap levenshtein context "with concrete examples" $ do- testPair levenshtein "kitten" "sitting" 3- testPair levenshtein "cake" "drake" 2- testPair levenshtein "saturday" "sunday" 3- testPair levenshtein "red" "wax" 3-#if __GLASGOW_HASKELL__ >= 710- testPair levenshtein "a😀c" "abc" 1-#endif- testPair levenshtein "lucky" "lucky" 0- testPair levenshtein "" "" 0+ testPair levenshtein "kitten" "sitting" 3+ testPair levenshtein "cake" "drake" 2+ testPair levenshtein "saturday" "sunday" 3+ testPair levenshtein "red" "wax" 3+ testPair levenshtein "a😀c" "abc" 1+ testPair levenshtein "lucky" "lucky" 0+ testPair levenshtein "" "" 0 describe "levenshteinNorm" $ do testSwap levenshteinNorm- testPair levenshteinNorm "kitten" "sitting" (4 % 7)- testPair levenshteinNorm "cake" "drake" (3 % 5)- testPair levenshteinNorm "saturday" "sunday" (5 % 8)- testPair levenshteinNorm "red" "wax" (0 % 1)-#if __GLASGOW_HASKELL__ >= 710- testPair levenshteinNorm "a😀c" "abc" (2 % 3)-#endif- testPair levenshteinNorm "lucky" "lucky" (1 % 1)- testPair levenshteinNorm "" "" (1 % 1)+ testPair levenshteinNorm "kitten" "sitting" (4 % 7)+ testPair levenshteinNorm "cake" "drake" (3 % 5)+ testPair levenshteinNorm "saturday" "sunday" (5 % 8)+ testPair levenshteinNorm "red" "wax" (0 % 1)+ testPair levenshteinNorm "a😀c" "abc" (2 % 3)+ testPair levenshteinNorm "lucky" "lucky" (1 % 1)+ testPair levenshteinNorm "" "" (1 % 1) describe "damerauLevenshtein" $ do testSwap damerauLevenshtein testPair damerauLevenshtein "veryvery long" "very long" 4- testPair damerauLevenshtein "thing" "think" 1- testPair damerauLevenshtein "nose" "ones" 2- testPair damerauLevenshtein "thing" "sign" 3- testPair damerauLevenshtein "red" "wax" 3-#if __GLASGOW_HASKELL__ >= 710- testPair damerauLevenshtein "a😀c" "abc" 1-#endif- testPair damerauLevenshtein "lucky" "lucky" 0- testPair damerauLevenshtein "" "" 0+ testPair damerauLevenshtein "thing" "think" 1+ testPair damerauLevenshtein "nose" "ones" 2+ testPair damerauLevenshtein "thing" "sign" 3+ testPair damerauLevenshtein "red" "wax" 3+ testPair damerauLevenshtein "a😀c" "abc" 1+ testPair damerauLevenshtein "lucky" "lucky" 0+ testPair damerauLevenshtein "" "" 0 describe "damerauLevenshteinNorm" $ do testSwap damerauLevenshteinNorm testPair damerauLevenshteinNorm "veryvery long" "very long" (9 % 13)- testPair damerauLevenshteinNorm "thing" "think" (4 % 5)- testPair damerauLevenshteinNorm "nose" "ones" (1 % 2)- testPair damerauLevenshteinNorm "thing" "sign" (2 % 5)- testPair damerauLevenshteinNorm "red" "wax" (0 % 1)-#if __GLASGOW_HASKELL__ >= 710- testPair damerauLevenshteinNorm "a😀c" "abc" (2 % 3)-#endif- testPair damerauLevenshteinNorm "lucky" "lucky" (1 % 1)- testPair damerauLevenshteinNorm "" "" (1 % 1)+ testPair damerauLevenshteinNorm "thing" "think" (4 % 5)+ testPair damerauLevenshteinNorm "nose" "ones" (1 % 2)+ testPair damerauLevenshteinNorm "thing" "sign" (2 % 5)+ testPair damerauLevenshteinNorm "red" "wax" (0 % 1)+ testPair damerauLevenshteinNorm "a😀c" "abc" (2 % 3)+ testPair damerauLevenshteinNorm "lucky" "lucky" (1 % 1)+ testPair damerauLevenshteinNorm "" "" (1 % 1) describe "hamming" $ do testSwap hamming testPair hamming "karolin" "kathrin" (Just 3) testPair hamming "karolin" "kerstin" (Just 3) testPair hamming "1011101" "1001001" (Just 2) testPair hamming "2173896" "2233796" (Just 3)- testPair hamming "toned" "roses" (Just 3)- testPair hamming "red" "wax" (Just 3)-#if __GLASGOW_HASKELL__ >= 710- testPair hamming "a😀c" "abc" (Just 1)-#endif- testPair hamming "lucky" "lucky" (Just 0)- testPair hamming "" "" (Just 0)- testPair hamming "small" "big" Nothing+ testPair hamming "toned" "roses" (Just 3)+ testPair hamming "red" "wax" (Just 3)+ testPair hamming "a😀c" "abc" (Just 1)+ testPair hamming "lucky" "lucky" (Just 0)+ testPair hamming "" "" (Just 0)+ testPair hamming "small" "big" Nothing describe "jaro" $ do- testPair jaro "aa" "a" (5 % 6)- testPair jaro "a" "aa" (5 % 6)- testPair jaro "martha" "marhta" (17 % 18)- testPair jaro "marhta" "martha" (17 % 18)- testPair jaro "dwayne" "duane" (37 % 45)- testPair jaro "duane" "dwayne" (37 % 45)- testPair jaro "dixon" "dicksonx" (23 % 30)- testPair jaro "dicksonx" "dixon" (23 % 30)- testPair jaro "jones" "johnson" (83 % 105)- testPair jaro "johnson" "jones" (83 % 105)- testPair jaro "brain" "brian" (14 % 15)- testPair jaro "brian" "brain" (14 % 15)- testPair jaro "five" "ten" (0 % 1)- testPair jaro "ten" "five" (0 % 1)- testPair jaro "lucky" "lucky" (1 % 1)-#if __GLASGOW_HASKELL__ >= 710- testPair jaro "a😀c" "abc" (7 % 9)-#endif- testPair jaro "" "" (0 % 1)+ testPair jaro "aa" "a" (5 % 6)+ testPair jaro "a" "aa" (5 % 6)+ testPair jaro "martha" "marhta" (17 % 18)+ testPair jaro "marhta" "martha" (17 % 18)+ testPair jaro "dwayne" "duane" (37 % 45)+ testPair jaro "duane" "dwayne" (37 % 45)+ testPair jaro "dixon" "dicksonx" (23 % 30)+ testPair jaro "dicksonx" "dixon" (23 % 30)+ testPair jaro "jones" "johnson" (83 % 105)+ testPair jaro "johnson" "jones" (83 % 105)+ testPair jaro "brain" "brian" (14 % 15)+ testPair jaro "brian" "brain" (14 % 15)+ testPair jaro "five" "ten" (0 % 1)+ testPair jaro "ten" "five" (0 % 1)+ testPair jaro "lucky" "lucky" (1 % 1)+ testPair jaro "a😀c" "abc" (7 % 9)+ testPair jaro "" "" (0 % 1) describe "jaroWinkler" $ do- testPair jaroWinkler "aa" "a" (17 % 20)- testPair jaroWinkler "a" "aa" (17 % 20)- testPair jaroWinkler "martha" "marhta" (173 % 180)- testPair jaroWinkler "marhta" "martha" (173 % 180)- testPair jaroWinkler "dwayne" "duane" (21 % 25)- testPair jaroWinkler "duane" "dwayne" (21 % 25)- testPair jaroWinkler "dixon" "dicksonx" (61 % 75)- testPair jaroWinkler "dicksonx" "dixon" (61 % 75)- testPair jaroWinkler "jones" "johnson" (437 % 525)- testPair jaroWinkler "johnson" "jones" (437 % 525)- testPair jaroWinkler "brain" "brian" (71 % 75)- testPair jaroWinkler "brian" "brain" (71 % 75)- testPair jaroWinkler "five" "ten" (0 % 1)- testPair jaroWinkler "ten" "five" (0 % 1)- testPair jaroWinkler "lucky" "lucky" (1 % 1)-#if __GLASGOW_HASKELL__ >= 710- testPair jaroWinkler "a😀c" "abc" (4 % 5)-#endif- testPair jaroWinkler "" "" (0 % 1)+ testPair jaroWinkler "aa" "a" (17 % 20)+ testPair jaroWinkler "a" "aa" (17 % 20)+ testPair jaroWinkler "martha" "marhta" (173 % 180)+ testPair jaroWinkler "marhta" "martha" (173 % 180)+ testPair jaroWinkler "dwayne" "duane" (21 % 25)+ testPair jaroWinkler "duane" "dwayne" (21 % 25)+ testPair jaroWinkler "dixon" "dicksonx" (61 % 75)+ testPair jaroWinkler "dicksonx" "dixon" (61 % 75)+ testPair jaroWinkler "jones" "johnson" (437 % 525)+ testPair jaroWinkler "johnson" "jones" (437 % 525)+ testPair jaroWinkler "brain" "brian" (71 % 75)+ testPair jaroWinkler "brian" "brain" (71 % 75)+ testPair jaroWinkler "five" "ten" (0 % 1)+ testPair jaroWinkler "ten" "five" (0 % 1)+ testPair jaroWinkler "lucky" "lucky" (1 % 1)+ testPair jaroWinkler "a😀c" "abc" (4 % 5)+ testPair jaroWinkler "" "" (0 % 1)+ testPair jaroWinkler "aaaaaaaaaab" "aaaaaaaaaa" (54 % 55)+ testPair jaroWinkler "aaaaaaaaaaaaaaaaaaaab" "aaaaaaaaaaaaaaaaaaaa" (104 % 105) describe "overlap" $ do testSwap overlap- testPair overlap "fly" "butterfly" (1 % 1)- testPair overlap "night" "nacht" (3 % 5)- testPair overlap "context" "contact" (5 % 7)- testPair overlap "red" "wax" (0 % 1)-#if __GLASGOW_HASKELL__ >= 710- testPair overlap "a😀c" "abc" (2 % 3)-#endif+ testPair overlap "fly" "butterfly" (1 % 1)+ testPair overlap "night" "nacht" (3 % 5)+ testPair overlap "context" "contact" (5 % 7)+ testPair overlap "red" "wax" (0 % 1)+ testPair overlap "a😀c" "abc" (2 % 3) testPair overlap "lucky" "lucky" (1 % 1) describe "jaccard" $ do testSwap jaccard- testPair jaccard "xxx" "xyx" (1 % 2)- testPair jaccard "night" "nacht" (3 % 7)+ testPair jaccard "xxx" "xyx" (1 % 2)+ testPair jaccard "night" "nacht" (3 % 7) testPair jaccard "context" "contact" (5 % 9)-#if __GLASGOW_HASKELL__ >= 710- testPair overlap "a😀c" "abc" (2 % 3)-#endif- testPair jaccard "lucky" "lucky" (1 % 1)+ testPair overlap "a😀c" "abc" (2 % 3)+ testPair jaccard "lucky" "lucky" (1 % 1) -- | Test that given function returns the same results when order of -- arguments is swapped.- testSwap :: (Eq a, Show a) => (Text -> Text -> a) -> SpecWith () testSwap f = context "if we swap the arguments" $ it "produces the same result" $- property $ \a b -> f a b === f b a+ property $ \a b ->+ f a b === f b a -- | Create spec for given metric function applying it to two 'Text' values -- and comparing the result with expected one.--testPair :: (Eq a, Show a)- => (Text -> Text -> a) -- ^ Function to test- -> Text -- ^ First input- -> Text -- ^ Second input- -> a -- ^ Expected result- -> SpecWith ()-testPair f a b r = it ("‘" ++ T.unpack a ++ "’ and ‘" ++ T.unpack b ++ "’") $- f a b `shouldBe` r+testPair ::+ (Eq a, Show a) =>+ -- | Function to test+ (Text -> Text -> a) ->+ -- | First input+ Text ->+ -- | Second input+ Text ->+ -- | Expected result+ a ->+ SpecWith ()+testPair f a b r =+ it ("‘" ++ T.unpack a ++ "’ and ‘" ++ T.unpack b ++ "’") $+ f a b `shouldBe` r
text-metrics.cabal view
@@ -1,82 +1,104 @@-name: text-metrics-version: 0.3.0-cabal-version: >= 1.10-tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.1-license: BSD3-license-file: LICENSE.md-author: Mark Karpov <markkarpov92@gmail.com>-maintainer: Mark Karpov <markkarpov92@gmail.com>-homepage: https://github.com/mrkkrp/text-metrics-bug-reports: https://github.com/mrkkrp/text-metrics/issues-category: Text, Algorithms-synopsis: Calculate various string metrics efficiently-build-type: Simple-description: Calculate various string metrics efficiently.-extra-doc-files: CHANGELOG.md- , README.md+cabal-version: 2.4+name: text-metrics+version: 0.3.3+license: BSD-3-Clause+license-file: LICENSE.md+maintainer: Mark Karpov <markkarpov92@gmail.com>+author: Mark Karpov <markkarpov92@gmail.com>+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+description: Calculate various string metrics efficiently.+category: Text, Algorithms+build-type: Simple+extra-doc-files:+ CHANGELOG.md+ README.md source-repository head- type: git- location: https://github.com/mrkkrp/text-metrics.git+ type: git+ location: https://github.com/mrkkrp/text-metrics.git flag dev- description: Turn on development settings.- manual: True- default: False+ description: Turn on development settings.+ default: False+ manual: True library- build-depends: base >= 4.7 && < 5.0- , containers >= 0.5.6.2 && < 0.6- , text >= 0.2 && < 1.3- , vector >= 0.11 && < 0.13- exposed-modules: Data.Text.Metrics- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ exposed-modules: Data.Text.Metrics+ default-language: GHC2021+ build-depends:+ 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 -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -O2 -Wall+ test-suite tests- main-is: Main.hs- hs-source-dirs: tests- type: exitcode-stdio-1.0- build-depends: QuickCheck >= 2.8 && < 3.0- , base >= 4.7 && < 5.0- , hspec >= 2.0 && < 3.0- , text >= 0.2 && < 1.3- , text-metrics- if flag(dev)- ghc-options: -Wall -Werror- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: tests+ default-language: GHC2021+ build-depends:+ 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 -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -O2 -Wall+ benchmark bench-speed- main-is: Main.hs- hs-source-dirs: bench-speed- type: exitcode-stdio-1.0- build-depends: base >= 4.7 && < 5.0- , criterion >= 0.6.2.1 && < 1.3- , deepseq >= 1.4 && < 1.5- , text >= 0.2 && < 1.3- , text-metrics- if flag(dev)- ghc-options: -O2 -Wall -Werror- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench/speed+ default-language: GHC2021+ build-depends:+ 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:+ -Wall -Werror -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -O2 -Wall+ benchmark bench-memory- main-is: Main.hs- hs-source-dirs: bench-memory- type: exitcode-stdio-1.0- build-depends: base >= 4.7 && < 5.0- , deepseq >= 1.4 && < 1.5- , text >= 0.2 && < 1.3- , text-metrics- , weigh >= 0.0.4- if flag(dev)- ghc-options: -O2 -Wall -Werror- else- ghc-options: -O2 -Wall- default-language: Haskell2010+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: bench/memory+ default-language: GHC2021+ build-depends:+ 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:+ -Wall -Werror -Wredundant-constraints -Wpartial-fields+ -Wunused-packages++ else+ ghc-options: -O2 -Wall