diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,3 @@ +## Text Metrics 0.1.0 + +* Initial release. diff --git a/Data/Text/Metrics.hs b/Data/Text/Metrics.hs new file mode 100644 --- /dev/null +++ b/Data/Text/Metrics.hs @@ -0,0 +1,135 @@ +-- | +-- Module : Data.Text.Metrics +-- Copyright : © 2016 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- The module provides efficient implementations of various strings metrics. +-- It works with strict 'Text' values and returns either 'Natural' numbers +-- (because the metrics cannot be negative), or @'Ratio' 'Natural'@ values +-- because returned values are rational non-negative numbers by definition. + +{-# LANGUAGE CPP #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} + +module Data.Text.Metrics + ( -- * Levenshtein variants + levenshtein + , levenshteinNorm + , damerauLevenshtein + , damerauLevenshteinNorm + -- * Other + , hamming ) +where + +import Data.Ratio +import Data.Text +import Foreign +import Foreign.C.Types +import Numeric.Natural +import System.IO.Unsafe +import qualified Data.Text as T +import qualified Data.Text.Foreign as TF + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative +#endif + +---------------------------------------------------------------------------- +-- Levenshtein variants + +-- | Return Levenshtein distance between two 'Text' values. Classic +-- Levenshtein distance between two strings is minimal number of operations +-- necessary to transform one string into another. For Levenshtein distance +-- allowed operations are: deletion, insertion, and substitution. +-- +-- See also: . + +levenshtein :: Text -> Text -> Natural +levenshtein = withTwo c_levenshtein + +foreign import ccall unsafe "tmetrics_levenshtein" + c_levenshtein :: CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO CUInt + +-- | Return normalized Levenshtein distance between two 'Text' values. +-- Result is a non-negative rational number (represented as @'Ratio' +-- 'Natural'@), where 0 signifies no similarity between the strings, while 1 +-- means exact match. The operation is virtually as fast as 'levenshtein'. +-- +-- See also: . + +levenshteinNorm :: Text -> Text -> Ratio Natural +levenshteinNorm = norm levenshtein +{-# INLINE levenshteinNorm #-} + +-- | Return 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. The +-- function is about 20% slower than 'levenshtein', but still pretty fast. +-- +-- See also: . + +damerauLevenshtein :: Text -> Text -> Natural +damerauLevenshtein = withTwo c_damerau_levenshtein + +foreign import ccall unsafe "tmetrics_damerau_levenshtein" + c_damerau_levenshtein :: CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO CUInt + +-- | Return normalized Damerau-Levenshtein distance between two 'Text' +-- values. Result is a non-negative rational number (represented as @'Ratio' +-- 'Natural'@), where 0 signifies no similarity between the strings, while 1 +-- means exact match. The operation is virtually as fast as +-- 'damerauLevenshtein'. +-- +-- See also: . + +damerauLevenshteinNorm :: Text -> Text -> Ratio Natural +damerauLevenshteinNorm = norm damerauLevenshtein +{-# INLINE damerauLevenshteinNorm #-} + +---------------------------------------------------------------------------- +-- Other + +-- | /O(n)/ Return Hamming distance between two 'Text' values. Hamming +-- distance is defined as number of positions at which the corresponding +-- symbols are different. The input 'Text' values should be of equal length +-- or 'Nothing' will be returned. +-- +-- See also: . + +hamming :: Text -> Text -> Maybe Natural +hamming a b = + if T.length a == T.length b + then Just . unsafePerformIO . TF.useAsPtr a $ \aptr size -> + TF.useAsPtr b $ \bptr _ -> + fromIntegral <$> c_hamming (fromIntegral size) aptr bptr + else Nothing + +foreign import ccall unsafe "tmetrics_hamming" + c_hamming :: CUInt -> Ptr Word16 -> Ptr Word16 -> IO CUInt + +---------------------------------------------------------------------------- +-- Helpers + +withTwo + :: (CUInt -> Ptr Word16 -> CUInt -> Ptr Word16 -> IO CUInt) + -> Text + -> Text + -> Natural +withTwo f a b = + unsafePerformIO . TF.useAsPtr a $ \aptr asize -> + TF.useAsPtr b $ \bptr bsize -> + fromIntegral <$> f (fromIntegral asize) aptr (fromIntegral bsize) bptr +{-# INLINE withTwo #-} + +norm :: (Text -> Text -> Natural) -> Text -> Text -> Ratio Natural +norm f a b = + let r = f a b + in if r == 0 + then 1 % 1 + else 1 % 1 - r % fromIntegral (max (T.length a) (T.length b)) +{-# INLINE norm #-} diff --git a/LICENSE.md b/LICENSE.md new file mode 100644 --- /dev/null +++ b/LICENSE.md @@ -0,0 +1,28 @@ +Copyright © 2016 Mark Karpov + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +* Neither the name Mark Karpov nor the names of contributors may be used to + endorse or promote products derived from this software without specific + prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS +OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN +NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, +OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, +EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,69 @@ +# Text Metrics + +[![License BSD3](https://img.shields.io/badge/license-BSD3-brightgreen.svg)](http://opensource.org/licenses/BSD-3-Clause) +[![Hackage](https://img.shields.io/hackage/v/text-metrics.svg?style=flat)](https://hackage.haskell.org/package/text-metrics) +[![Stackage Nightly](http://stackage.org/package/text-metrics/badge/nightly)](http://stackage.org/nightly/package/text-metrics) +[![Stackage LTS](http://stackage.org/package/text-metrics/badge/lts)](http://stackage.org/lts/package/text-metrics) +[![Build Status](https://travis-ci.org/mrkkrp/text-metrics.svg?branch=master)](https://travis-ci.org/mrkkrp/text-metrics) +[![Coverage Status](https://coveralls.io/repos/mrkkrp/text-metrics/badge.svg?branch=master&service=github)](https://coveralls.io/github/mrkkrp/text-metrics?branch=master) + +The library provides efficient implementations of various strings metrics. +It works with strict `Text` values and returns either `Natural` numbers +(because the metrics cannot be negative), or `Ratio Natural` values because +returned values are rational non-negative numbers by definition. + +The current version of the package implements: + +* [Levenshtein distance](http://en.wikipedia.org/wiki/Levenshtein_distance) +* [Normalized Levenshtein distance](http://en.wikipedia.org/wiki/Levenshtein_distance) +* [Damerau-Levenshtein distance](http://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance) +* [Normalized Damerau-Levenshtein distance](http://en.wikipedia.org/wiki/Damerau%E2%80%93Levenshtein_distance) +* [Hamming distance](http://en.wikipedia.org/wiki/Hamming_distance) + +TODO list: + +* [Overlap coefficient](http://en.wikipedia.org/wiki/Overlap_coefficient) +* [Jaccard similarity coefficient](http://en.wikipedia.org/wiki/Jaccard_index) +* [Jaro distance](http://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance) +* [Jaro-Winkler distance](http://en.wikipedia.org/wiki/Jaro%E2%80%93Winkler_distance) + +## 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: + +* `edit-distance` allows to specify costs for every operation when + calculating Levenshtein distance (insertion, deletion, substitution, and + transposition). This is rarely needed though in real-world applications, + IMO. + +* `edit-distance` only provides single Levenshtein distance, `text-metrics` + aims to provide implementations of most string metrics algorithms. + +* `edit-distance` works on `Strings`, while `text-metrics` works on strict + `Text` values. + +* As `README.md` of `edit-distance` states, “[the algorithms] have been + fairly heavily optimized”, which is apparently true, yet the + `text-metrics` is faster for short strings (under 64 characters) and even + faster for longer strings (scales better). How much faster? For short + strings more than ×2.5, and about ×4 for longer strings. + +## Implementation + +All “meat” of the algorithms is written is C in a rather straightforward +way. Levenshtein variants are based on the “iterative algorithm with two +matrix rows” from Wikipedia with additional improvement that we do not copy +current row of distances into previous row, but just swap the pointers +(which is OK, since the arrays have equal length and current row will be +overwritten in the next iteration anyway). + +Normalized versions are defined as thin (inlined) Haskell wrappers. + +## License + +Copyright © 2016 Mark Karpov + +Distributed under BSD 3 clause license. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/bench/Main.hs b/bench/Main.hs new file mode 100644 --- /dev/null +++ b/bench/Main.hs @@ -0,0 +1,62 @@ +-- +-- Benchmarks for the ‘text-metrics’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +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 "hamming" hamming ] + +-- | 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'] diff --git a/cbits/text_metrics.c b/cbits/text_metrics.c new file mode 100644 --- /dev/null +++ b/cbits/text_metrics.c @@ -0,0 +1,136 @@ +/* + * This file is part of ‘text-metrics’ package. + * + * Copyright © 2016 Mark Karpov + * + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * * Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * * Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * * Neither the name Mark Karpov nor the names of contributors may be used to + * endorse or promote products derived from this software without specific + * prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS + * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN + * NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT + * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, + * OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF + * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, + * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#include "text_metrics.h" + +/* Levenshtein variants */ + +unsigned int tmetrics_levenshtein (unsigned int la, uint16_t *a, unsigned int lb, uint16_t *b) +{ + if (la == 0) return lb; + if (lb == 0) return la; + + unsigned int v_len = lb + 1; + unsigned int *v0 = malloc(sizeof(unsigned int) * v_len); + unsigned int *v1 = malloc(sizeof(unsigned int) * v_len); + unsigned int i, j; + + for (i = 0; i < v_len; i++) + v0[i] = i; + + for (i = 0; i < la; i++) + { + v1[0] = i + 1; + + for (j = 0; j < lb; j++) + { + unsigned int cost = *(a + i) == *(b + j) ? 0 : 1; + unsigned int x = *(v1 + j) + 1; + unsigned int y = *(v0 + j + 1) + 1; + unsigned int z = *(v0 + j) + cost; + *(v1 + j + 1) = x > y ? (y > z ? z : y) : (x > z ? z : x); + } + + unsigned int *ptr = v0; + v0 = v1; + v1 = ptr; + } + + unsigned int result = *(v0 + lb); + + free(v0); + free(v1); + + return result; +} + +unsigned int tmetrics_damerau_levenshtein (unsigned int la, uint16_t *a, unsigned int lb, uint16_t *b) +{ + if (la == 0) return lb; + if (lb == 0) return la; + + unsigned int v_len = lb + 1; + unsigned int *v0 = malloc(sizeof(unsigned int) * v_len); + unsigned int *v1 = malloc(sizeof(unsigned int) * v_len); + unsigned int *v2 = malloc(sizeof(unsigned int) * v_len); + unsigned int i, j; + + for (i = 0; i < v_len; i++) + v0[i] = i; + + for (i = 0; i < la; i++) + { + v1[0] = i + 1; + + for (j = 0; j < lb; j++) + { + unsigned int cost = *(a + i) == *(b + j) ? 0 : 1; + unsigned int x = *(v1 + j) + 1; + unsigned int y = *(v0 + j + 1) + 1; + unsigned int z = *(v0 + j) + cost; + *(v1 + j + 1) = x > y ? (y > z ? z : y) : (x > z ? z : x); + unsigned int val = *(v2 + j - 1) + cost; + if ( i > 0 && + j > 0 && + *(a + i) == *(b + j - 1) && + *(a + i - 1) == *(b + j) && + val < *(v1 + j + 1) ) + *(v1 + j + 1) = val; + } + + unsigned int *ptr = v0; + v0 = v1; + v1 = v2; + v2 = ptr; + } + + unsigned int result = *(v0 + lb); + + free(v0); + free(v1); + free(v2); + + return result; +} + +/* Other */ + +unsigned int tmetrics_hamming (unsigned int len, uint16_t *a, uint16_t *b) +{ + unsigned int acc = 0, i; + for (i = 0; i < len; i++) + { + if (*(a + i) != *(b + i)) acc++; + } + return acc; +} diff --git a/cbits/text_metrics.h b/cbits/text_metrics.h new file mode 100644 --- /dev/null +++ b/cbits/text_metrics.h @@ -0,0 +1,49 @@ +/* + * This file is part of ‘text-metrics’ package. + * + * Copyright © 2016 Mark Karpov + * + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions are met: + * + * * Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * + * * Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * + * * Neither the name Mark Karpov nor the names of contributors may be used to + * endorse or promote products derived from this software without specific + * prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY EXPRESS + * OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES + * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN + * NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY DIRECT, INDIRECT, + * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT + * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, + * OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF + * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING + * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, + * EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + */ + +#ifndef TEXT_METRICS_H +#define TEXT_METRICS_H + +#include +#include + +/* Levenshein variants */ + +unsigned int tmetrics_levenshtein (unsigned int, uint16_t *, unsigned int, uint16_t *); +unsigned int tmetrics_damerau_levenshtein (unsigned int, uint16_t *, unsigned int, uint16_t *); + +/* Other */ + +unsigned int tmetrics_hamming (unsigned int, uint16_t *, uint16_t *); + +#endif /* TEXT_METRICS_H */ diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -0,0 +1,123 @@ +-- +-- Tests for the ‘text-metrics’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Main (main) where + +import Data.Ratio +import Data.Text (Text) +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 + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + 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 + 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) + 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 + 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) + 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) + testPair hamming "lucky" "lucky" (Just 0) + testPair hamming "" "" (Just 0) + testPair hamming "small" "big" Nothing + +-- | 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 + +-- | 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 diff --git a/text-metrics.cabal b/text-metrics.cabal new file mode 100644 --- /dev/null +++ b/text-metrics.cabal @@ -0,0 +1,105 @@ +-- +-- Cabal configuration for ‘text-metrics’ package. +-- +-- Copyright © 2016 Mark Karpov +-- +-- Redistribution and use in source and binary forms, with or without +-- modification, are permitted provided that the following conditions are +-- met: +-- +-- * Redistributions of source code must retain the above copyright notice, +-- this list of conditions and the following disclaimer. +-- +-- * Redistributions in binary form must reproduce the above copyright +-- notice, this list of conditions and the following disclaimer in the +-- documentation and/or other materials provided with the distribution. +-- +-- * Neither the name Mark Karpov nor the names of contributors may be used +-- to endorse or promote products derived from this software without +-- specific prior written permission. +-- +-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY +-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY +-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +-- POSSIBILITY OF SUCH DAMAGE. + +name: text-metrics +version: 0.1.0 +cabal-version: >= 1.10 +license: BSD3 +license-file: LICENSE.md +author: Mark Karpov +maintainer: Mark Karpov +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 +extra-source-files: cbits/*.h + +source-repository head + type: git + location: https://github.com/mrkkrp/text-metrics.git + +flag dev + description: Turn on development settings. + manual: True + default: False + +library + build-depends: base >= 4.7 && < 5.0 + , text >= 0.2 && < 1.3 + if !impl(ghc >= 7.10) + build-depends: nats == 1.* + exposed-modules: Data.Text.Metrics + c-sources: cbits/text_metrics.c + include-dirs: cbits + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +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 >= 0.1.0 + if !impl(ghc >= 7.10) + build-depends: nats == 1.* + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010 + +benchmark bench + main-is: Main.hs + hs-source-dirs: bench + type: exitcode-stdio-1.0 + build-depends: base >= 4.7 && < 5.0 + , criterion >= 0.6.2.1 && < 1.2 + , deepseq >= 1.4 && < 1.5 + , text >= 0.2 && < 1.3 + , text-metrics >= 0.1.0 + if !impl(ghc >= 7.10) + build-depends: nats == 1.* + if flag(dev) + ghc-options: -Wall -Werror + else + ghc-options: -O2 -Wall + default-language: Haskell2010