bytes-metrics (empty) → 0.1.0.0
raw patch · 7 files changed
+276/−0 lines, 7 filesdep +basedep +bytes-metricsdep +byteslicesetup-changed
Dependencies added: base, bytes-metrics, byteslice, contiguous, gauge, primitive, quickcheck-classes-base, random, tasty, tasty-hunit, tasty-quickcheck
Files
- CHANGELOG.md +5/−0
- LICENSE +30/−0
- Setup.hs +3/−0
- bench/Main.hs +28/−0
- bytes-metrics.cabal +64/−0
- src/Data/Bytes/Metrics.hs +89/−0
- test/Main.hs +57/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for bytes-metrics++## 0.1.0.0 -- 2024-01-30++* First version.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2020, Eric Demko++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 of Andrew Martin nor the names of other+ 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 AND CONTRIBUTORS+"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+OWNER OR CONTRIBUTORS 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,28 @@+import Data.Bytes (Bytes)+import Data.Bytes.Metrics (levenshteinWithTolerance)+import Data.List (unfoldr)+import Gauge.Main (bench, bgroup, defaultMain, whnf)+import System.Random (mkStdGen, uniformR)++import qualified Data.Bytes.Text.Ascii as Ascii++main :: IO ()+main =+ defaultMain+ [ bgroup+ "80-chars"+ [ bench "distance-0" (whnf (uncurry $ levenshteinWithTolerance 0) strings)+ , bench "distance-1" (whnf (uncurry $ levenshteinWithTolerance 1) strings)+ , bench "distance-2" (whnf (uncurry $ levenshteinWithTolerance 2) strings)+ , bench "distance-3" (whnf (uncurry $ levenshteinWithTolerance 3) strings)+ , bench "distance-4" (whnf (uncurry $ levenshteinWithTolerance 4) strings)+ ]+ ]++prefix :: String+{-# NOINLINE prefix #-}+prefix = take 80 (unfoldr (Just . uniformR (' ', '~')) (mkStdGen 62861853071))++strings :: (Bytes, Bytes)+{-# NOINLINE strings #-}+strings = (Ascii.fromString $ prefix ++ "a", Ascii.fromString $ prefix ++ "b")
+ bytes-metrics.cabal view
@@ -0,0 +1,64 @@+cabal-version: 3.0+name: bytes-metrics+version: 0.1.0.0+synopsis: Calculate string metrics on Bytes efficiently+description:+ Calculate string metrics on Bytes efficiently. This library currently only+ calculates Levenshtein distance, but other metrics may be added in the future.++homepage: https://github.com/byteverse/bytes-metrics+bug-reports: https://github.com/byteverse/bytes-metrics/issues+license: BSD-3-Clause+license-file: LICENSE+author: Eric Demko+maintainer: amartin@layer3com.com+copyright: 2020 Eric Demko+category: Data+build-type: Simple+extra-doc-files: CHANGELOG.md++library+ exposed-modules: Data.Bytes.Metrics+ build-depends:+ , base >=4.14 && <5+ , byteslice >=0.2.1 && <0.3+ , contiguous >=0.6.1 && <0.7+ , primitive >=0.7 && <0.10++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -O2++test-suite test+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ ghc-options: -Wall -O2+ build-depends:+ , base >=4.12.0.0 && <5+ , bytes-metrics+ , byteslice+ , primitive >=0.7 && <0.10+ , quickcheck-classes-base >=0.6+ , tasty >=1.2.3+ , tasty-hunit >=0.10.0.2+ , tasty-quickcheck >=0.10++benchmark bench+ type: exitcode-stdio-1.0+ build-depends:+ , base+ , bytes-metrics+ , byteslice+ , gauge+ , random >=1.2++ ghc-options: -Wall -O2+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++source-repository head+ type: git+ location: git://github.com/byteverse/bytes-metrics.git
+ src/Data/Bytes/Metrics.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Bytes.Metrics+ ( levenshteinWithTolerance+ , isWithinLevenshtein+ ) where++import Control.Monad.ST (runST)+import Data.Bytes (Bytes)++import qualified Data.Bytes as Bytes+import qualified Data.Primitive.Contiguous as Arr+import qualified Data.Primitive.PrimArray as Prim++{- | Determine if two 'Bytes' are within a given Levenshtein distance of each other (inclusive).+Computes in O(t*min(n,m)) time and O(min(t,n,m)) space,+where @n,m@ are lengths of the input strings and @t@ is the tolerance.+-}+isWithinLevenshtein :: Int -> Bytes -> Bytes -> Bool+isWithinLevenshtein t a b = maybe False (<= t) $ levenshteinWithTolerance t a b++{- | Determine Levenshtein distance between two strings, as long as their+distance is within (inclusive) the given tolerance.+Computes in O(t*min(n,m)) time and O(min(t,n,m)) space,+where @n,m@ are lengths of the input strings and @t@ is the tolerance.+-}+levenshteinWithTolerance :: Int -> Bytes -> Bytes -> Maybe Int+levenshteinWithTolerance !t !a !b+ -- ensure that the first string (which will create columns) is longer+ -- this minimizes the space needed for intermediate results+ | t == 0 = if a == b then Just 0 else Nothing+ | m > n = levenshteinWithWorker t b a+ | otherwise = levenshteinWithWorker t a b+ where+ m = Bytes.length a+ n = Bytes.length b++-- Precondition: Length of A is less than or equal to length of B.+levenshteinWithWorker :: Int -> Bytes -> Bytes -> Maybe Int+levenshteinWithWorker !t !a !b+ | t < deltaN = Nothing+ | otherwise = runST $ do+ -- during table creation, some column indices will be negative:+ -- the contents of such oob cells must not impact the contents of in-bounds cells+ -- using maxBound to initialize could provoke overflow on increment+ -- using n+m will definitely be larger than any entry in the table, but likely small enough to avoid wrapping arithmetic+ row :: Prim.MutablePrimArray s Int <- Arr.replicateMut rowLen (n + m)+ let outerLoop !rowIx+ | rowIx <= m = do+ let innerLoop !bandIx+ | bandIx < rowLen = do+ let colIx = rowIx - p + bandIx+ let initCost = if rowIx == 0 && colIx == 0 then 0 else maxBound+ let !byteA = Bytes.unsafeIndex a (rowIx - 1)+ let !byteB = Bytes.unsafeIndex b (colIx - 1)+ !editCost <-+ if+ | not (1 <= colIx && colIx <= n) -> pure maxBound+ | byteA == byteB -> Arr.read row bandIx+ | otherwise -> (1 +) <$> Arr.read row bandIx+ !insCost <-+ if 0 <= bandIx - 1+ then (1 +) <$> Arr.read row (bandIx - 1)+ else pure maxBound+ !delCost <-+ if bandIx + 1 < rowLen+ then (1 +) <$> Arr.read row (bandIx + 1)+ else pure maxBound+ let cost = min (min initCost editCost) (min insCost delCost)+ Arr.write row bandIx cost+ innerLoop (bandIx + 1)+ | otherwise = pure ()+ innerLoop 0+ outerLoop (rowIx + 1)+ | otherwise = pure ()+ outerLoop 0+ d <- Arr.read row (deltaN + p)+ pure $ Just d+ where+ m = Bytes.length a+ n = Bytes.length b+ deltaN = n - m+ -- FIXME what a gross name, what even is p really supposed to be? a one-sided external tolerance for the diagonal band?+ p = (t - deltaN) `quot` 2+ -- \| the other way to think of this length is `t - deltaN + (1 - t `mod` 2)`+ -- the floor operation to compute `p` is what gives it that awful last term, and why I'm sticking with the paper's presentation+ rowLen = 1 + deltaN + 2 * p
+ test/Main.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++import Data.Bytes (Bytes)+import Data.Bytes.Metrics (levenshteinWithTolerance)+import Data.Word (Word8)++import Test.Tasty (TestTree, defaultMain, testGroup)+import Test.Tasty.QuickCheck (Arbitrary (..), discard, testProperty, (===))++import qualified Data.Bytes as Bytes+import qualified Data.Bytes.Text.Ascii as Ascii+import qualified Data.Primitive as Prim+import qualified Test.Tasty.QuickCheck as TQC++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests =+ testGroup+ "Tests"+ [ testGroup+ "sanity properties"+ [ testProperty "commutative" $ \a b ->+ let d = levenshteinWithTolerance 100 a b+ d' = levenshteinWithTolerance 100 b a+ in d === d'+ , testProperty "non-negative" $ \a b ->+ case levenshteinWithTolerance 100 a b of+ Nothing -> discard+ Just d -> d >= 0+ , testProperty "zero distance to self" $ \t a ->+ levenshteinWithTolerance (abs t) a a === Just 0+ , testProperty "distance to empty is length" $ \a ->+ let d = Bytes.length a+ in levenshteinWithTolerance d a Bytes.empty === Just d+ ]+ , testGroup+ "golden tests"+ [ testProperty "hellofworld" $+ let a = Ascii.fromString "hello world"+ b = Ascii.fromString "hellofworld"+ in levenshteinWithTolerance 10 a b == Just 1+ , testProperty "xyzzy" $+ let a = Ascii.fromString "xyzzy"+ b = Ascii.fromString "syzygy"+ in levenshteinWithTolerance 10 a b == Just 3+ ]+ ]++instance Arbitrary Bytes where+ arbitrary = do+ bs :: [Word8] <- TQC.arbitrary+ pure $ Bytes.fromByteArray $ Prim.byteArrayFromList bs