diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,7 @@ +# `levenshtein` changelog + +For a full list of changes, see the history on [*GitHub*](https://github.com/hapytex/levenshtein). + +## Version 0.1.0.0 + +The first version that can determine the Levenshtein distance and edits necessary. diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright Willem Van Onsem (c) 2021 + +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 Willem Van Onsem 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,102 @@ +# levenshtein +[![Build Status of the package by GitHub actions](https://github.com/hapytex/levenshtein/actions/workflows/build-ci.yml/badge.svg)](https://github.com/hapytex/levenshtein/actions/workflows/build-ci.yml) +[![Build Status of the package by Hackage](https://matrix.hackage.haskell.org/api/v2/packages/levenshtein/badge)](https://matrix.hackage.haskell.org/#/package/levenshtein) +[![Hackage version badge](https://img.shields.io/hackage/v/levenshtein.svg)](https://hackage.haskell.org/package/levenshtein) + +## Usage + +The module `Data.Foldable.Levenshtein` exports a data type `Edit` that +represent the possible ways to edit a list by `Add`ing an element, `Rem`oving +an element, `Copy`ing (do nothing with the element), and `Swap` with a new value. + +One can apply such edits to a list with the `applyEdits` function, for example: + +```haskell +Prelude> applyEdits [Copy 1,Swap 3 4,Swap 0 2,Swap 2 5] [1,3,0,2] +Just [1,4,2,5] +``` + +We can also calculate the minimal list of edits necessary to turn one list into another one, +for example: + +```haskell +Prelude> levenshtein [1,3,0,2] [1,4,2,5] +(3,[Copy 1,Swap 3 4,Swap 0 2,Swap 2 5]) +``` + +here it means that the smallest edit distance is three, and that in order to transform +`[1,3,0,2]` to `[1,4,2,5]` we copy `1` change `3` for `4`, change `0` for `2`, and change `2` for `5`. + +## Package structure + +The package contains one module: **`Data.Foldable.Levenshtein`**. +This module provides functions to determine the edit distance and +a list of edits to turn one `Foldable` of items to another `Foldable` +of items. The foldables are first converted to a list, so the edits +always eventually produce a *list* of edits, even if (one of) the `Foldable`s +is for example a `Tree`, `Maybe`, etc. + +Besides the `Edit` object, the module exports three types of functions: + + 1. functions that return the edit distance together with a list of *reversed* edits; + 2. functions that return the edit distance with a list of edits (not reversed); and + 3. functions that only calculate the edit distance, not the edits itself. + +The third type is more an optimized version of the first two types since it will +take less memory and finish slightly faster. + +Some functions allow to specify the penalty for an insertion, deletion, and replacement, +and this even per item. + +In the table below, we show the different implementations to determine the Levenshtein distance: + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
EditsEqEquality functionEq
penalty functionsdefault
NormalgenericLevenshteingenericLevenshtein'levenshtein'levenshtein
ReversedgenericReversedLevenshteingenericReversedLevenshtein'reversedLevenshtein'reversedLevenshtein
WithoutgenericLevenshteinDistancegenericLevenshteinDistance'levenshteinDistance'levenshteinDistance
+ +## `levenshtein` is *safe* Haskell + +The `levenshtein` package does not work with arrays, vectors, +etc. but only vanilla lists, making this a safe package. + +## Contribute + +You can contribute by making a pull request on the [*GitHub +repository*](https://github.com/hapytex/levenshtein). + +You can contact the package maintainer by sending a mail to +[`hapytexeu+gh@gmail.com`](mailto:hapytexeu+gh@gmail.com). 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/levenshtein.cabal b/levenshtein.cabal new file mode 100644 --- /dev/null +++ b/levenshtein.cabal @@ -0,0 +1,58 @@ +name: levenshtein +version: 0.1.0.0 +synopsis: Calculate the edit distance between two foldables. +description: + A package to determine the edit distance between two 'Foldable's. + These are converted to lists, and the Levenshtein distance determine + how many additions, removals and changes are necessary to change + the first list into the second list. +homepage: https://github.com/hapytex/levenshtein#readme +license: BSD3 +license-file: LICENSE +author: Willem Van Onsem +maintainer: hapytexteu+gh@gmail.com +copyright: 2021 Willem Van Onsem +category: tools +build-type: Simple +extra-source-files: + README.md + , CHANGELOG.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: + Data.Foldable.Levenshtein + build-depends: + base >= 4.7 && < 5 + , binary >= 0.2 + , hashable >=1.2.7.0 + , deepseq >=1.4.3.0 + , QuickCheck + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/hapytex/levenshtein + +test-suite steinlevenh + type: exitcode-stdio-1.0 + main-is: Main.hs + hs-source-dirs: test + other-modules: + Data.Foldable.LevenshteinSpec + build-depends: + base + , levenshtein + , hspec ==2.* + , QuickCheck >=2.13 + build-tool-depends: + hspec-discover:hspec-discover == 2.* + default-language: Haskell2010 + default-extensions: + BlockArguments + , OverloadedStrings + ghc-options: -Wall -Wcompat -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wredundant-constraints diff --git a/src/Data/Foldable/Levenshtein.hs b/src/Data/Foldable/Levenshtein.hs new file mode 100644 --- /dev/null +++ b/src/Data/Foldable/Levenshtein.hs @@ -0,0 +1,294 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, DeriveTraversable, Safe #-} + +{-| +Module : Data.Foldable.Levenshtein +Description : A module to determine the edit distance and the 'Edit's to rewrite a given 'Foldable' to another 'Foldable'. +Maintainer : hapytexeu+gh@gmail.com +Stability : experimental +Portability : POSIX + +The /Levenshtein distance/ is the /minimal/ number of additions, removals, and updates one has to make to +convert one list of items into another list of items. In this module we provide some functions that makes +it convenient to calculate the distance and the sequence of 'Edit's, and furthermore ways to alter the score +for an addition, removal, edit that can depend on what item is modified. +-} + +module Data.Foldable.Levenshtein ( + -- * Calculate the Levenshtein distance + genericLevenshteinDistance, genericLevenshteinDistance', levenshteinDistance, levenshteinDistance' + -- * Obtain the Levenshtein distance together with the path of 'Edit's + , genericLevenshtein, genericLevenshtein', levenshtein, levenshtein' + -- * Obtain the Levenshtein distance together with a reversed path of 'Edit's + , genericReversedLevenshtein, genericReversedLevenshtein', reversedLevenshtein, reversedLevenshtein' + -- * Data type to present modifications from one 'Foldable' to the other.a + , Edit(Add, Rem, Copy, Swap), applyEdits + ) where + +import Control.Arrow(second) +import Control.DeepSeq(NFData, NFData1) + +import Data.Binary(Binary(put, get), getWord8, putWord8) +import Data.Data(Data) +import Data.Foldable(toList) +import Data.Functor.Classes(Eq1(liftEq), Ord1(liftCompare)) +import Data.Hashable(Hashable) +import Data.Hashable.Lifted(Hashable1) + +import GHC.Generics(Generic, Generic1) + +import Test.QuickCheck(oneof) +import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary), Arbitrary1(liftArbitrary), arbitrary1) + +_defaddrem :: Num b => a -> b +_defaddrem = const 1 + +_defswap :: Num b => a -> a -> b +_defswap = const _defaddrem + +_addDefaults :: Num b => ((a -> b) -> (a -> b) -> (a -> a -> b) -> c) -> c +_addDefaults f = f _defaddrem _defaddrem _defswap + +-- | A data type that is used to list how to edit a sequence to form another sequence. +data Edit a + = Add a -- ^ We add the given element to the sequence. + | Rem a -- ^ We remove the given element to the sequence. + | Copy a -- ^ We copy an element from the sequence, this basically act as a /no-op/. + | Swap a a -- ^ We modify the given first item into the second item, this thus denotes a replacement. + deriving (Data, Eq, Foldable, Functor, Generic, Generic1, Ord, Read, Show, Traversable) + +instance Arbitrary1 Edit where + liftArbitrary arb = oneof [Add <$> arb, Rem <$> arb, Copy <$> arb, Swap <$> arb <*> arb] + +instance Arbitrary a => Arbitrary (Edit a) where + arbitrary = arbitrary1 + +instance Binary a => Binary (Edit a) where + put (Add x) = putWord8 0 >> put x + put (Rem x) = putWord8 1 >> put x + put (Copy x) = putWord8 2 >> put x + put (Swap xa xb) = putWord8 3 >> put xa >> put xb + get = do + tp <- getWord8 + case tp of + 0 -> Add <$> get + 1 -> Rem <$> get + 2 -> Copy <$> get + 3 -> Swap <$> get <*> get + _ -> fail ("The number " ++ show tp ++ " is not a valid Edit item.") + +instance Eq1 Edit where + liftEq eq = go + where go (Add xa) (Add xb) = eq xa xb + go (Rem xa) (Rem xb) = eq xa xb + go (Copy xa) (Copy xb) = eq xa xb + go (Swap xa ya) (Swap xb yb) = eq xa xb && eq ya yb + go _ _ = False + +instance Hashable a => Hashable (Edit a) + +instance Hashable1 Edit + +instance NFData a => NFData (Edit a) + +instance NFData1 Edit + +instance Ord1 Edit where + liftCompare cmp = go + where go (Add a) (Add b) = cmp a b + go (Add _) _ = LT + go _ (Add _) = GT + go (Rem a) (Rem b) = cmp a b + go (Rem _) _ = LT + go _ (Rem _) = GT + go (Copy a) (Copy b) = cmp a b + go (Copy _) _ = LT + go _ (Copy _) = GT + go (Swap xa ya) (Swap xb yb) = cmp xa xb <> cmp ya yb + +-- | Apply the given list of 'Edit's to the given list. +-- If the 'Edit's make sense, it returns the result wrapped +-- in a 'Just', if a check with the item that is removed/replaced +-- fails, the function will return 'Nothing'. +applyEdits :: Eq a + => [Edit a] -- ^ The given list of 'Edit's to apply to the given list. + -> [a] -- ^ The list of items to edit with the given 'Edit's. + -> Maybe [a] -- ^ The modified list, given the checks hold about what item to remove/replace wrapped in a 'Just'; 'Nothing' otherwise. +applyEdits [] ys = Just ys +applyEdits (Add x : xs) ys = (x :) <$> applyEdits xs ys +applyEdits (Rem x : xs) (y : ys) + | x == y = applyEdits xs ys +applyEdits (Swap y x : xs) (y' : ys) + | y == y' = (x :) <$> applyEdits xs ys +applyEdits (Copy x : xs) (y : ys) + | x == y = (y :) <$> applyEdits xs ys +applyEdits _ _ = Nothing + +-- | Determine the edit distance where an addition, removal, and change all count as one, and where +-- the 'Eq' instance is used to determine whether two items are equivalent, this is for example useful +-- for case-insensitve matching. +levenshteinDistance :: (Foldable f, Foldable g, Eq a, Num b, Ord b) + => f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> b -- ^ The edit distance between the two 'Foldable's. +levenshteinDistance = levenshteinDistance' (==) + +-- | Determine the edit distance together with the steps to transform the first 'Foldable' +-- (as list) into a second 'Foldable' (as list). Add, remove and swapping items all count +-- as one edit distance. +levenshtein :: (Foldable f, Foldable g, Eq a, Num b, Ord b) + => f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ The edit distance between the two 'Foldable's. +levenshtein = levenshtein' (==) + +-- | Determine the edit distance together with the steps to transform the first 'Foldable' +-- (as list) into a second 'Foldable' (as list). Add, remove and swapping items all count +-- as one edit distance. The first parameter is a function to determine if two items +-- are of the 'Foldable's are considered equivalent. +levenshtein' :: (Foldable f, Foldable g, Num b, Ord b) + => (a -> a -> Bool) -- ^ The given equivalence relation to work with. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ The edit distance between the two 'Foldable's together with a list of 'Edit's to transform the first 'Foldable' to the second one. +levenshtein' = _addDefaults . genericLevenshtein' + +-- | Determine the edit distance together with the steps to transform the first 'Foldable' +-- (as list) into a second 'Foldable' (as list). Add, remove and swapping items all count +-- as one edit distance. The equality function '(==)' is used to determine if two items are +-- equivalent. +reversedLevenshtein :: (Foldable f, Foldable g, Eq a, Num b, Ord b) + => f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ The edit distance between the two 'Foldable's together with the 'Edit's to make to convert the first sequence into the second. +reversedLevenshtein = reversedLevenshtein' (==) + +-- | Determine the edit distance together with the steps to transform the first 'Foldable' +-- (as list) into a second 'Foldable' (as list) in /reversed/ order. Add, remove and +-- swapping items all count as one edit distance. The given equality function is used +-- to determine if two items are equivalent. +reversedLevenshtein' :: (Foldable f, Foldable g, Num b, Ord b) + => (a -> a -> Bool) -- ^ The given equivalence relation to work with. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ The edit distance between the two 'Foldable's together with a reversed list of 'Edit's to transform the original sequence into the target sequence. +reversedLevenshtein' = _addDefaults . genericReversedLevenshtein' + +-- | Determine the edit distance to transform the first 'Foldable' (as list) +-- into a second 'Foldable' (as list). Add, remove and swapping items all count +-- as one edit distance. The first parameter is an equivalence relation that +-- is used to determine if two items are considered equivalent. +levenshteinDistance' :: (Foldable f, Foldable g, Num b, Ord b) + => (a -> a -> Bool) -- ^ The given equivalence relation to work with. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> b -- ^ The edit distance between the two 'Foldable's. +levenshteinDistance' = _addDefaults . genericLevenshteinDistance' + +-- | A function to determine the /Levenshtein distance/ by specifying the cost functions of adding, removing and editing characters. This function returns +-- the sum of the costs to transform the first 'Foldable' (as list) into the second 'Foldable' (as list). The '(==)' function is used +-- to determine if two items are equivalent. +genericLevenshteinDistance :: (Foldable f, Foldable g, Eq a, Num b, Ord b) + => (a -> b) -- ^ The cost of adding the given item. The return value should be positive. + -> (a -> b) -- ^ The cost of removing the given item. The return value should be positive. + -> (a -> a -> b) -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter. The return value should be positive. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> b -- ^ The edit distance between the two 'Foldable's. +genericLevenshteinDistance = genericLevenshteinDistance' (==) + +-- | A function to determine the /Levenshtein distance/ by specifying the cost functions of adding, removing and editing characters. This function returns +-- the sum of the costs to transform the first 'Foldable' (as list) into the second 'Foldable' (as list). The first parameter is an equivalence relation +-- to determine if two items are considered equivalent. +genericLevenshteinDistance' :: (Foldable f, Foldable g, Num b, Ord b) + => (a -> a -> Bool) -- ^ The given equivalence relation to work with. + -> (a -> b) -- ^ The cost of adding the given item. The return value should be positive. + -> (a -> b) -- ^ The cost of removing the given item. The return value should be positive. + -> (a -> a -> b) -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter. The return value should be positive. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> b -- ^ The edit distance between the two 'Foldable's. +genericLevenshteinDistance' eq ad rm sw xs' ys' = last (foldl (nextRow tl) row0 xs') + where + row0 = scanl (\w i -> w + ad i) 0 tl + nextCell x l y lt t + | eq x y = lt + | scs <= scr && scs <= sca = scs + | sca <= scr = sca + | otherwise = scr + where sca = l + ad y + scr = t + rm x + scs = lt + sw x y + curryNextCell x l = uncurry (uncurry (nextCell x l)) + nextRow ys da@(~(dn:ds)) x = scanl (curryNextCell x) (dn+rm x) (zip (zip ys da) ds) + tl = toList ys' + +-- | A function to determine the /Levenshtein distance/ together with a list of 'Edit's +-- to apply to convert the first 'Foldable' (as list) into the second item (as list) +-- The cost functions of adding, removing and editing characters will be used to minimize +-- the total edit distance. The first parameter is an equivalence relation that is used +-- to determine if two items of the 'Foldable's are considered equivalent. +genericLevenshtein' :: (Foldable f, Foldable g, Num b, Ord b) + => (a -> a -> Bool) -- ^ The given equivalence relation to work with. + -> (a -> b) -- ^ The cost of adding the given item. The return value should be positive. + -> (a -> b) -- ^ The cost of removing the given item. The return value should be positive. + -> (a -> a -> b) -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter. The return value should be positive. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /normal/ order as second item to transform the first sequence to the second one. +genericLevenshtein' eq ad rm sw xs' = second reverse . genericReversedLevenshtein' eq ad rm sw xs' + +-- | A function to determine the /Levenshtein distance/ together with a list of 'Edit's +-- to apply to convert the first 'Foldable' (as list) into the second item (as list) +-- The cost functions of adding, removing and editing characters will be used to minimize +-- the total edit distance. The '(==)' function is used to determine if two items of the +-- 'Foldable's are considered equivalent. +genericLevenshtein :: (Foldable f, Foldable g, Eq a, Num b, Ord b) + => (a -> b) -- ^ The cost of adding the given item. The return value should be positive. + -> (a -> b) -- ^ The cost of removing the given item. The return value should be positive. + -> (a -> a -> b) -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter. The return value should be positive. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /normal/ order as second item to transform the first sequence to the second one. +genericLevenshtein = genericLevenshtein' (==) + +-- | A function to determine the /Levenshtein distance/ together with a list of 'Edit's +-- to apply to convert the first 'Foldable' (as list) into the second item (as list) +-- in /reversed/ order. The cost functions of adding, removing and editing characters +-- will be used to minimize the total edit distance. The first parameter is an +-- equivalence relation that is used to determine if two items of the 'Foldable's are considered equivalent. +genericReversedLevenshtein' :: (Foldable f, Foldable g, Num b, Ord b) + => (a -> a -> Bool) -- ^ The given equivalence relation to work with. + -> (a -> b) -- ^ The cost of adding the given item. The return value should be positive. + -> (a -> b) -- ^ The cost of removing the given item. The return value should be positive. + -> (a -> a -> b) -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter. The return value should be positive. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /reversed/ order as second item to transform the first 'Foldable' (as list) to the second 'Foldable' (as list). +genericReversedLevenshtein' eq ad rm sw xs' ys' = last (foldl (nextRow tl) row0 xs') + where + row0 = scanl (\(w, is) i -> (w+ad i, Add i: is)) (0, []) tl + nextCell x (l, le) y (lt, lte) (t, te) + | eq x y = (lt, Copy x : lte) + | scs <= scr && scs <= sca = (scs, Swap x y:lte) + | sca <= scr = (sca, Add y:le) + | otherwise = (scr, Rem x:te) + where sca = l + ad y + scr = t + rm x + scs = lt + sw x y + curryNextCell x l = uncurry (uncurry (nextCell x l)) + nextRow ys da@(~(~(dn, de):ds)) x = scanl (curryNextCell x) (dn+rm x,Rem x:de) (zip (zip ys da) ds) + tl = toList ys' + +-- | A function to determine the /Levenshtein distance/ together with a list of 'Edit's +-- to apply to convert the first 'Foldable' (as list) into the second item (as list) +-- in /reversed/ order. The cost functions of adding, removing and editing characters +-- will be used to minimize the total edit distance. The '(==)' function is used +-- to determine if two items of the 'Foldable's are considered equivalent. +genericReversedLevenshtein :: (Foldable f, Foldable g, Eq a, Num b, Ord b) + => (a -> b) -- ^ The cost of adding the given item. The return value should be positive. + -> (a -> b) -- ^ The cost of removing the given item. The return value should be positive. + -> (a -> a -> b) -- ^ The cost that it takes to replace an item of the first parameter with one of the second parameter. The return value should be positive. + -> f a -- ^ The given original sequence. + -> g a -- ^ The given target sequence. + -> (b, [Edit a]) -- ^ A 2-tuple with the edit score as first item, and a list of modifications in /reversed/ order as second item to transform the first 'Foldable' (as list) to the second 'Foldable' (as list). +genericReversedLevenshtein = genericReversedLevenshtein' (==) diff --git a/test/Data/Foldable/LevenshteinSpec.hs b/test/Data/Foldable/LevenshteinSpec.hs new file mode 100644 --- /dev/null +++ b/test/Data/Foldable/LevenshteinSpec.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE ExistentialQuantification, RankNTypes, TypeApplications #-} + +module Data.Foldable.LevenshteinSpec ( + spec + ) where + +import Data.Foldable.Levenshtein(applyEdits, levenshtein, levenshteinDistance) + +import Test.Hspec(Spec, it) +import Test.QuickCheck(maxSuccess, property, quickCheckWith, stdArgs) + +ntimes :: Int +ntimes = 100000 + +spec :: Spec +spec = do + it "lowerbound string difference" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (lowerBoundLengthDiff @ Int))) + it "upperbound largest string" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (upperBoundLengthDiff @ Int))) + it "if zero then same list" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (ifZeroThenSame @ Int))) + it "test triangle inequality" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (triangleInequality @ Int))) + it "test applying edits" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (testApplyingEdits @ Int))) + it "Hamming distance bound" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (hammingDistanceBound @ Int))) + it "lowerbound string difference" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (lowerBoundLengthDiff @ Char))) + it "upperbound largest string" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (upperBoundLengthDiff @ Char))) + it "if zero then same list" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (ifZeroThenSame @ Char))) + it "test triangle inequality" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (triangleInequality @ Char))) + it "test applying edits" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (testApplyingEdits @ Char))) + it "Hamming distance bound" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (hammingDistanceBound @ Char))) + it "lowerbound string difference" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (lowerBoundLengthDiff @ Bool))) + it "upperbound largest string" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (upperBoundLengthDiff @ Bool))) + it "if zero then same list" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (ifZeroThenSame @ Bool))) + it "test triangle inequality" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (triangleInequality @ Bool))) + it "test applying edits" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (testApplyingEdits @ Bool))) + it "Hamming distance bound" (quickCheckWith stdArgs { maxSuccess = ntimes } (property (hammingDistanceBound @ Bool))) + + +lowerBoundLengthDiff :: forall a . Eq a => [a] -> [a] -> Bool +lowerBoundLengthDiff xs ys = abs (length xs - length ys) <= levenshteinDistance xs ys + +upperBoundLengthDiff :: forall a . Eq a => [a] -> [a] -> Bool +upperBoundLengthDiff xs ys = levenshteinDistance xs ys <= max (length xs :: Int) (length ys) + +triangleInequality :: forall a . Eq a => [a] -> [a] -> [a] -> Bool +triangleInequality xs ys zs = levenshteinDistance xs zs <= levenshteinDistance xs ys + (levenshteinDistance ys zs :: Int) + +ifZeroThenSame :: forall a . Eq a => [a] -> [a] -> Bool +ifZeroThenSame xs ys = (levenshteinDistance xs ys == (0 :: Int)) == (xs == ys) + +testApplyingEdits :: forall a . Eq a => [a] -> [a] -> Bool +testApplyingEdits xs ys = applyEdits (snd (levenshtein xs ys)) xs == Just ys + +hammingDistanceBound :: forall a . Eq a => [a] -> [a] -> Bool +hammingDistanceBound xs ys = length xs /= length ys || levenshteinDistance xs ys <= hammingDistance xs ys + +hammingDistance :: forall a . Eq a => [a] -> [a] -> Int +hammingDistance (x:xs) (y:ys) + | x == y = hammingDistance xs ys + | otherwise = 1 + hammingDistance xs ys +hammingDistance _ _ = 0 diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,11 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} +-- cabal v2-test --test-show-details=direct +-- cabal v2-test --test-show-details=direct --test-options="--color --format=progress" + +module Main + +-- main :: IO ExitCode +-- main = runAllLiquid + +-- runAllLiquid :: IO ExitCode +-- runAllLiquid = mconcat <$> mapM runLiquid orderedSrcFiles