diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,13 @@ +# Changelog for edit-distance-linear + +## v0.2.0.1 + +* Made the test executable and the LLVM codegen optional. + +## v0.2.0.0 + +* Reimplemented with mutable arrays and rather low-level optimizations. + +## v0.1.0.0 + +* Initial implementation with Data.Vector. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Georg Rudoy (c) 2019 + +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 Georg Rudoy 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,18 @@ +# edit-distance-linear + +[![Build Status][travis-badge]][travis] + +The pure Haskell implementation of the Levenshtein edit distance, with linear space complexity. + +## Comparison + +There are already several other existing implementations, but the goals and design decisions vary. In particular, this package is intended to be used to: +* compare long strings (think tens of thousands of characters), driving the implementation to live in the `ST` monad and aim at linear space complexity to lower GC pressure; +* not care about Unicode, thus accepting `ByteString`s and comparing them byte-by-byte rather than character-by-character (or glyph-by-glyph, or whatever is the right notion of an edit for Unicode). + +Among the alternatives: +* [text-metrics](http://hackage.haskell.org/package/text-metrics) — uses a similar algorithm, but cares about Unicode, making it 4-5 times slower. +* [edit-distance](http://hackage.haskell.org/package/edit-distance) — uses a very different algorithm (which we might implement here one day with huge potential benefits), which tends to consume more memory (I'm not up for estimating its space asymptotics, though). + +[travis]: +[travis-badge]: diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,12 @@ +module Main where + +import qualified Data.ByteString.Char8 as BS +import Text.EditDistance.Linear + +main :: IO () +main = do + let s1 = BS.replicate 10000 'a' + let s2 = s1 + let s3 = BS.replicate 10000 'b' + print $ levenshteinDistance s1 s2 + print $ levenshteinDistance s1 s3 diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,26 @@ +{-# LANGUAGE BangPatterns, OverloadedStrings #-} + +import qualified Data.ByteString.Char8 as BS +import qualified Data.Text as T +import Criterion.Main +import Data.Text.Metrics + +import Text.EditDistance.Linear + +main :: IO () +main = defaultMain + [ bgroup "same string/ed-linear" [ bench (show num) $ nf (\s -> levenshteinDistance s s) $ BS.replicate num 'a' + | num <- nums + ] + , bgroup "same string/text-metrics" [ bench (show num) $ nf (uncurry levenshtein) (T.replicate num "a", T.replicate num "a") + | num <- nums + ] + , bgroup "diff strings/ed-linear" [ bench (show num) $ nf (uncurry levenshteinDistance) (BS.replicate num 'a', BS.replicate num 'b') + | num <- nums + ] + , bgroup "diff strings/text-metrics" [ bench (show num) $ nf (uncurry levenshtein) (T.replicate num "a", T.replicate num "b") + | num <- nums + ] + ] + where + nums = [ 1000, 2000, 5000, 10000, 20000 ] diff --git a/edit-distance-linear.cabal b/edit-distance-linear.cabal new file mode 100644 --- /dev/null +++ b/edit-distance-linear.cabal @@ -0,0 +1,106 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: 52175124e00b64f40bb9551356b58a8b08d4d0f2b7ec2366fa339ffc53e59081 + +name: edit-distance-linear +version: 0.2.0.1 +synopsis: Efficient implementation Levenshtein distance in linear memory. +description: Please see the README on GitHub at +category: Algorithms +homepage: https://github.com/0xd34df00d/edit-distance-linear#readme +bug-reports: https://github.com/0xd34df00d/edit-distance-linear/issues +author: Georg Rudoy +maintainer: 0xd34df00d@gmail.com +copyright: 2019 Georg Rudoy +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: https://github.com/0xd34df00d/edit-distance-linear + +flag llvm + description: Use the LLVM code generator (strongly recommended) + manual: True + default: True + +flag with-executable + description: Build the test executable (a fast and dirty way of benchmarking, for the package development only) + manual: True + default: False + +library + exposed-modules: + Text.EditDistance.Linear + other-modules: + Paths_edit_distance_linear + hs-source-dirs: + src + ghc-options: -Wall + build-depends: + array + , base >=4.7 && <5 + , bytestring + if flag(llvm) + ghc-options: -fllvm + default-language: Haskell2010 + +executable edit-distance-linear-exe + main-is: Main.hs + other-modules: + Paths_edit_distance_linear + hs-source-dirs: + app + ghc-options: -Wall -threaded -rtsopts + build-depends: + array + , base >=4.7 && <5 + , bytestring + , edit-distance-linear + if !(flag(with-executable)) + buildable: False + default-language: Haskell2010 + +test-suite edit-distance-linear-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_edit_distance_linear + hs-source-dirs: + test + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + QuickCheck + , array + , base >=4.7 && <5 + , bytestring + , edit-distance + , edit-distance-linear + , hspec + default-language: Haskell2010 + +benchmark edit-distance-linear-bench + type: exitcode-stdio-1.0 + main-is: Bench.hs + other-modules: + Paths_edit_distance_linear + hs-source-dirs: + bench + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: + array + , base >=4.7 && <5 + , bytestring + , criterion + , edit-distance-linear + , text + , text-metrics + default-language: Haskell2010 diff --git a/src/Text/EditDistance/Linear.hs b/src/Text/EditDistance/Linear.hs new file mode 100644 --- /dev/null +++ b/src/Text/EditDistance/Linear.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleContexts #-} + +module Text.EditDistance.Linear where + +import qualified Data.Array.Base as A(unsafeRead, unsafeWrite) +import qualified Data.Array.ST as A +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Unsafe as BU +import Control.Monad.ST + +levenshteinDistance :: BS.ByteString -> BS.ByteString -> Int +levenshteinDistance s1 s2 = runST $ do + v0Init <- A.newListArray (0, n) [0..] + v1Init <- A.newArray_ (0, n) + loop 0 v0Init v1Init + A.unsafeRead (if even m then v0Init else v1Init) n + + where + m = BS.length s1 + n = BS.length s2 + + loop :: Int -> A.STUArray s Int Int -> A.STUArray s Int Int -> ST s () + loop !i !v0 !v1 | i == m = pure () + | otherwise = do + A.unsafeWrite v1 0 (i + 1) + let !s1char = s1 `BU.unsafeIndex` i + let go !j !prev | j == n = pure () + | otherwise = do + delCost <- v0 `A.unsafeRead` (j + 1) + substCostBase <- v0 `A.unsafeRead` j + let !substCost = if s1char == s2 `BU.unsafeIndex` j then 0 else 1 + let !res = min (substCost + substCostBase) $ 1 + min delCost prev + A.unsafeWrite v1 (j + 1) res + go (j + 1) res + go 0 (i + 1) + loop (i + 1) v1 v0 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,24 @@ +{-# LANGUAGE ViewPatterns #-} + +import qualified Data.ByteString.Char8 as BS +import qualified Text.EditDistance as TED +import Test.Hspec +import Test.QuickCheck + +import Text.EditDistance.Linear + +baseLevDist :: String -> String -> Int +baseLevDist = TED.levenshteinDistance TED.defaultEditCosts + +main :: IO () +main = hspec $ do + describe "Obvious cases" $ do + it "Edit distance to self is always 0" $ + property $ \(BS.pack -> s) -> levenshteinDistance s s `shouldBe` 0 + it "Edit distance to completely different string is strictly positive" $ do + property $ \(BS.pack . getNonEmpty -> s) -> levenshteinDistance s (BS.map succ s) > 0 + it "Edit distance to completely different string is not greater than string's length" $ do + property $ \(BS.pack -> s) -> levenshteinDistance s (BS.map succ s) <= BS.length s + describe "Comparing to edit-distance" $ + it "Edit distances always match" $ + property $ \(getASCIIString -> s1) (getASCIIString -> s2) -> levenshteinDistance (BS.pack s1) (BS.pack s2) `shouldBe` baseLevDist s1 s2