fuzzystrmatch-pg (empty) → 0.1.0.0

raw patch · 8 files changed

+567/−0 lines, 8 filesdep +basedep +criteriondep +fuzzystrmatch-pg

Dependencies added: base, criterion, fuzzystrmatch-pg, hspec, quickcheck-instances, text, vector

Files

• CHANGELOG.md +7/−0
• LICENSE +21/−0
• README.md +63/−0
• fuzzystrmatch-pg.cabal +57/−0
• src/Data/FuzzyStrMatch.hs +22/−0
• src/Data/FuzzyStrMatch/Levenshtein.hs +276/−0
• test/spec/LevenshteinSpec.hs +76/−0
• test/spec/Main.hs +45/−0

@@ -0,0 +1,7 @@+# Change Log++All notable changes to this package are documented in this file. This project adheres to [Haskell PVP](https://pvp.haskell.org/) versioning.++## 0.1.0.0++- Implement Levenshtein distance functions

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2026 Taimoor Zaeem++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,63 @@+# fuzzystrmatch-pg++[![Build](https://github.com/taimoorzaeem/fuzzystrmatch-pg/actions/workflows/build.yml/badge.svg)](https://github.com/taimoorzaeem/fuzzystrmatch-pg/actions/workflows/build.yml)++Haskell implementation of PostgreSQL extension/module [fuzzystrmatch](https://www.postgresql.org/docs/current/fuzzystrmatch.html).++## Roadmap++- [x] Levenshtein - Implement Levenshtein distance functions++## Quick Start++```haskell+import Data.FuzzyStrMatch (levenshtein)+import Data.Text++kitten  = "kitten"  :: Text+sitting = "sitting" :: Text++ghci> levenshtein kitten sitting+3++ghci> levenshteinLessEqual kitten sitting 3+Just 3++-- Bounded version which exits early, hence much faster+ghci> levenshteinLessEqual kitten sitting 2+Nothing+```++## Benchmark++Benchmarking with `criterion` library:++```haskell+let source = "aaaaaaaaaaaaaaaaaaaaaaaaaaaa"+    target = "abababababababababababababababababababababababababababab"+    maxD   = 3++defaultMain+  [+    bench "levenshtein" $ nf (levenshtein source) target+  , bench "levenshteinLessEqual" $ nf (levenshteinLessEqual source target) maxD+  ]+```++```+benchmarking levenshtein+time                 217.0 μs   (214.5 μs .. 219.0 μs)+                     0.999 R²   (0.999 R² .. 1.000 R²)+mean                 212.9 μs   (211.4 μs .. 214.6 μs)+std dev              5.201 μs   (4.374 μs .. 6.315 μs)+variance introduced by outliers: 19% (moderately inflated)++benchmarking levenshteinLessEqual+time                 45.01 μs   (44.79 μs .. 45.29 μs)+                     1.000 R²   (1.000 R² .. 1.000 R²)+mean                 45.09 μs   (44.86 μs .. 45.49 μs)+std dev              936.6 ns   (617.6 ns .. 1.526 μs)+variance introduced by outliers: 17% (moderately inflated)+```++We believe that the difference would be much more on longer strings.

@@ -0,0 +1,57 @@+name:               fuzzystrmatch-pg+version:            0.1.0.0+synopsis:           Determine string similarities and distance+description:        Haskell implementation of PostgreSQL fuzzystrmatch+                    extension+license:            MIT+license-file:       LICENSE+author:             Taimoor Zaeem+maintainer:         Taimoor Zaeem <taimoorzaeem@gmail.com>+category:           Data, Text, Algorithms+homepage:           https://github.com/taimoorzaeem/fuzzystrmatch-pg+bug-reports:        https://github.com/taimoorzaeem/fuzzystrmatch-pg/issues+build-type:         Simple+extra-source-files: CHANGELOG.md+extra-doc-files:    README.md+cabal-version:      1.18++tested-with:+    GHC == 9.4.8+  , GHC == 9.6.6+  , GHC == 9.8.4+  , GHC == 9.10.1+  , GHC == 9.12.2++source-repository head+  type: git+  location: https://github.com/taimoorzaeem/fuzzystrmatch-pg++library+  default-language:   Haskell2010+  default-extensions: NoImplicitPrelude+                      OverloadedStrings+  hs-source-dirs:     src+  exposed-modules:    Data.FuzzyStrMatch+                      Data.FuzzyStrMatch.Levenshtein+  build-depends:      base    >= 4.9   && < 4.23+                    , text    >= 1.2.2 && < 2.2+                    , vector  >= 0.11  && < 0.14++  ghc-options:        -Wall -Wunused-packages++test-suite spec+  type:               exitcode-stdio-1.0+  default-language:   Haskell2010+  default-extensions: NoImplicitPrelude+                      OverloadedStrings+  hs-source-dirs:     test/spec+  main-is:            Main.hs+  other-modules:      LevenshteinSpec+  build-depends:      base                  >= 4.9   && < 4.23+                    , criterion+                    , fuzzystrmatch-pg+                    , hspec                 >= 2.3   && < 2.12+                    , quickcheck-instances  >= 0.3.33 && < 0.4+                    , text                  >= 1.2.2 && < 2.2++  ghc-options:        -Wall -Wunused-packages

@@ -0,0 +1,22 @@+{- |+Module      : Data.FuzzyStrMatch+Description : Export all string matching functions+Copyright   : (c) 2026 Taimoor Zaeem+License     : MIT+Maintainer  : Taimoor Zaeem <taimoorzaeem@gmail.com>+Stability   : Experimental+Portability : Portable++Determine string similarities and distance+-}+module Data.FuzzyStrMatch+  (+  -- * API+    levenshtein+  , levenshteinWithCosts+  , levenshteinLessEqual+  , levenshteinLessEqualWithCosts+  )+  where++import Data.FuzzyStrMatch.Levenshtein

@@ -0,0 +1,276 @@+{- |+Module      : Data.FuzzyStrMatch.Levenshtein+Description : Calculate Levenshtein distances between texts+Copyright   : (c) 2026 Taimoor Zaeem+License     : MIT+Maintainer  : Taimoor Zaeem <taimoorzaeem@gmail.com>+Stability   : Experimental+Portability : Portable++Calculate levenshtein distance between strings+-}+{-# LANGUAGE RecordWildCards #-}+module Data.FuzzyStrMatch.Levenshtein+  ( levenshtein+  , levenshteinWithCosts+  , levenshteinLessEqual+  , levenshteinLessEqualWithCosts+  )+where++import qualified Data.Vector.Unboxed.Mutable as MVU+import qualified Data.Text as T++import Control.Monad.ST (runST, ST)+import Data.Text (Text)+import Prelude++-- Function Signatures taken from:+--   https://www.postgresql.org/docs/current/fuzzystrmatch.html++-- Algorithm:+--   https://en.wikipedia.org/wiki/Wagner–Fischer_algorithm++-- We have 3 popular vector implementation:+-- 1. Data.Vector+--      Linked-List implemenataion, allows thunks/laziness+-- 2. Data.Vector.Unboxed+--      Continuously allocated, much faster for primitive types, strict evaluation+-- 3. Data.Vector.Storable+--      C Compatible memory layout, used in FFI+--+-- Each of these also have a mutable implementation:+-- 1. Data.Vector.Mutable+-- 2. Data.Vector.Unboxed.Mutable+-- 3. Data.Vector.Storable.Mutable+--+-- Considering that we only store Int types and that we need+-- mutability + don't need laziness, the right data structure to+-- use here is "Unboxed Mutable Vector".++-- | Levenshtein distance state+data LState s = LState {+    source  :: Text+  , target  :: Text+  , sLen    :: Int+  , tLen    :: Int+  , prev    :: MVU.MVector s Int+  , curr    :: MVU.MVector s Int+  , insCost :: Int+  , delCost :: Int+  , subCost :: Int+  , maxD    :: Maybe Int+}++-- | Initialize the state+initLState :: Text -> Text -> Int -> Int -> Int -> Maybe Int -> ST s (LState s)+initLState s t ins del sub maxD = do+  let sLen = T.length s+      tLen = T.length t+      -- We always keep the larger string on the x-axis, helpes implementation+      -- For costs, we have to switch ins and del cost when source >= target+      sourceLenGreater = sLen >= tLen+      (s',t',sLen',tLen',ins',del') =+        if sourceLenGreater+          then (t,s,tLen,sLen,del,ins)+          else (s,t,sLen,tLen,ins,del)++  prev <- MVU.new $ tLen' + 1+  -- Init: [0,1,2,..,tLen] for default 1 cost of insertion+  -- Init: [0,2,4,..,tLen * 2] for cost of insertion equal 2 and so on+  _ <- mapFromUpto 0 tLen' (\i -> do+    MVU.write prev i (i * ins')+    return False+    )++  curr <- MVU.new $ tLen' + 1+  return $ LState s' t' sLen' tLen' prev curr ins' del' sub maxD++-- Calculation Matrix For Wagner-Fisher algorithm:+-- ==============================================+--+--  deletion cost, 1 for each by default+--        |+--        | +---+---+---+---+---+---+---++--        v | S | I | T | T | I | N | G |+--      +---+---+---+---+---+---+---+---++--      | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |  <-- insertion 1 for each by default+--  +---|---+---+---+---+---+---+---+---++--  | K | 1 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |+--  +---|---+---+---+---+---+---+---+---++--  | I | 2 | 2 | 1 | 2 | 3 | 4 | 5 | 6 |+--  +---|---+---+---+---+---+---+---+---++--  | T | 3 | 3 | 2 | 1 | 2 | 3 | 4 | 5 |+--  +---|---+---+---+---+---+---+---+---++--  | T | 4 | 4 | 3 | 2 | 1 | 2 | 3 | 4 |+--  +---|---+---+---+---+---+---+---+---++--  | E | 5 | 5 | 4 | 3 | 2 | 2 | 3 | 4 |+--  +---|---+---+---+---+---+---+---+---++--  | N | 6 | 6 | 5 | 4 | 3 | 3 | 2 | 3 |  <-- This is our answer!!+--  +---|---+---+---+---+---+---+---+---+++-- We only have to use two vectors prev and curr for calculation:+-- In this example:+--+--          +---+---+---+---+---+---+---++--          | S | I | T | T | I | N | G |+--      +---+---+---+---+---+---+---+---++--      | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |  <-- prev+--  +---|---+---+---+---+---+---+---+---++--  | K | 1 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |  <-- curr, becomes prev on next i+--  +---|---+---+---+---+---+---+---+---++--  | I | 2 | 2 | 1 | 2 | 3 | 4 | 5 | 6 |  <-- becomes curr on next i and so on+--  .+--  .+--  .++-- |+-- Calculate levenshtein distance between source and target string+--+-- @+-- >>> levenshtein "kitten" "sitting"+-- 3+-- @+levenshtein :: Text -> Text -> Int+levenshtein source target = levenshteinWithCosts source target 1 1 1++-- |+-- Calculate the levenshtein distance with different costs+--+-- @+-- >>> levenshteinWithCosts "kitten" "sitting" 1 1 2+-- 5+-- @+--+-- The costs correspond to insertion cost, deletion cost and substitution+-- cost respectively. In the above example, the total cost is @5@ because+-- there are 2 substitions, each with cost 2 and 1 deletion with cost 1.+levenshteinWithCosts :: Text -> Text -> Int -> Int -> Int -> Int+levenshteinWithCosts s t ins del sub = runST $ do++  lState@LState{..} <- initLState s t ins del sub Nothing+  _ <- runLevenshtein lState++  MVU.read prev tLen -- The last one is the answer at target length position++-- | Run Levenshtein algorithm+runLevenshtein :: LState s -> ST s Bool+runLevenshtein lState@LState{..} = do+  exit <- mapFromUpto 0 (sLen - 1) $ calculateCurrentCostAndWrite lState+  if exit then return True else return False++-- | Calculate cost for all cells in the current row+calculateCurrentCostAndWrite :: LState s -> (Int -> ST s Bool)+calculateCurrentCostAndWrite lState@LState{..} i = do+  -- Init: delete cost, goes like 1,2,3... for default 1 cost of deletion+  -- Init: delete cost, goes like 2,4,6... for when cost of deletion is 2 and so on+  MVU.write curr 0 ((i + 1) * delCost)+  exit <- mapFromUpto 0 (tLen - 1) $ calculateCurrentCellCostAndWrite lState i+  MVU.copy prev curr -- Copy current to previous before next iteration+  if exit then return True else return False++-- | Return closure/function/handler to compute the values in a row+--   This reads the current cell and write the minimum cost+--   after calculating insert cost, del cost and sub cost+calculateCurrentCellCostAndWrite :: LState s -> Int -> (Int -> ST s Bool)+calculateCurrentCellCostAndWrite LState{..} i j = do+  subCost' <- MVU.read prev j+  insCost' <- MVU.read prev (j + 1)+  delCost' <- MVU.read curr j++  -- NOTE: Although T.index is unsafe, safety can be guaranteed through+  --       outside bounds checking.++  -- If the character being compared are not equal, then it costs+  -- substitution cost.+  let curCost = if T.index source i == T.index target j then 0 else subCost+      minCost  = minimum [ insCost' + insCost, delCost' + delCost, subCost' + curCost ]++  MVU.write curr (j + 1) minCost++  return $ case maxD of+    Nothing -> False+    Just n  -> minCost > n && i == (j+1) -- if we are on the diagonal and the minCost > maxD, we break++-- | Map over the vector from index i to j and apply f on i+mapFromUpto :: Int -> Int -> (Int -> ST s Bool) -> ST s Bool+-- "s" is the type signature is a "Phantom Type" which is needed by GHC+-- state monad for type checking reasons. At runtime, "s" is nothing. So,+-- dont' worry about it too much+mapFromUpto i j f+  | i > j     = return False+  | otherwise = do+    exit <- f i+    if exit then return True else mapFromUpto (i+1) j f+++-- ========================+-- Threshold Optimization:+--  https://en.wikipedia.org/wiki/Wagner-Fischer_algorithm#Possible_modifications+-- =========================++-- |+-- Calculate the levenshtein distance with an upper bound. If the cost is+-- more than maximum, it returns @Nothing@.+--+-- @+-- >>> levenshteinLessEqual "kitten" "sitting" 3+-- Just 3+-- @+--+-- @+-- >>> levenshteinLessEqual "kitten" "sitting" 2+-- Nothing+-- @+--+-- It is important to note that this doesn't necessarily calculate the+-- complete cost and exits early as soon as the minimum costs exceeds+-- bound, hence much faster.+levenshteinLessEqual :: Text -> Text -> Int -> Maybe Int+levenshteinLessEqual source target = levenshteinLessEqualWithCosts source target 1 1 1++-- |+-- Calculate the levenshtein distance with an upper bound with different+-- costs. It works same as `levenshteinWithCosts` but with an upper bound.+levenshteinLessEqualWithCosts :: Text -> Text -> Int -> Int -> Int -> Int -> Maybe Int+levenshteinLessEqualWithCosts s t ins del sub maxD' = runST $ do++  lState@LState{..} <- initLState s t ins del sub (Just maxD')+  exit <- runLevenshtein lState++  if exit -- If exit if True, that means we have broken early, return Nothing+    then return Nothing+    else do+      -- An edge case we need to check, if the iterations are complete,+      -- we calculate the cost all the way for last row and then check+      -- if this is greater than maxD+      --        | +---+---+---+---+---+---+---++      --        v | S | I | T | T | I | N | G |+      --      +---+---+---+---+---+---+---+---++      --      | 0 |   |   |   |   |   |   |   |+      --  +---|---+---+---+---+---+---+---+---++      --  | K | 1 | 1 |   |   |   |   |   |   |+      --  +---|---+---+---+---+---+---+---+---++      --  | I | 2 | 2 | 1 | 2 | 3 | 4 | 5 | 6 | <- the diagnoal ends with cost 1+      --  +---|---+---+---+---+---+---+---+---+    but inserstion costs are added+      --+      -- Transpose case for this:+      --        | +---+---+---++      --        v | S | I | T | -- We DON'T need to implement this case,+      --      +---+---+---+---+ -- because we always choose the longer string+      --      | 0 |   |   |   | -- to be target INTERNALLY.+      --  +---|---+---+---+---++      --  | K | 1 | 1 |   |   |+      --  +---|---+---+---+---++      --  | I | 2 | 2 | 1 | 2 |+      --  +---|---+---+---+---++      --  | T | 3 | 3 | 2 | 1 | <- exit here, no need to calculate further+      --  +---|---+---+---+---++      --  | T | 4 | 4 | 3 | 2 |+      --  +---|---+---+---+---++      --  | E | 5 | 5 | 4 | 3 |+      --  +---|---+---+---+---++      --  | N | 6 | 6 | 5 | 4 |  <-- This is our answer, but we need to exit early+      --  +---|---+---+---+---++      d <- MVU.read prev tLen+      return $ if d > maxD' then Nothing else Just d

@@ -0,0 +1,76 @@+module LevenshteinSpec where++import qualified Data.Text as T++import Data.Text (Text)+import Data.FuzzyStrMatch.Levenshtein++import Test.Hspec+import Test.Hspec.QuickCheck+import Test.QuickCheck.Instances () -- imports instances only+import Prelude++empty :: Text+empty = ""++kitten :: Text+kitten = "kitten"++sitting :: Text+sitting = "sitting"++-- TODO: Test very large strings+spec :: Spec+spec = do+  describe "Test Levenshtein Distance" $ do+    context "should be 0 when inputs are equal" $ do+      prop "when both are non-empty strings" $ do+        \txt -> levenshtein txt txt `shouldBe` 0++      it "when both are empty strings" $+        levenshtein empty empty `shouldBe` 0++    context "distance should be equal to expectation" $ do+      it "should be 3 between kitten and sitting" $+        levenshtein kitten sitting `shouldBe` 3++      prop "when one argument is empty, distance should be length of other arg" $ do+        \source -> levenshtein source empty == (T.length source)++    context "order of arguments should not matter" $ do+      prop "application is commutative" $+        \source target -> levenshtein source target == (levenshtein target source)++    context "levenshtein with different costs" $ do+      it "insertion cost is doubled" $+        levenshteinWithCosts empty kitten 2 1 1 `shouldBe` 12 -- 6 insertions, so we get 12++      it "deletion cost is doubled" $+        levenshteinWithCosts kitten empty 1 2 1 `shouldBe` 12 -- 6 deletions, so we get 12++      it "substitution cost is doubled" $+        levenshteinWithCosts kitten sitting 1 1 2 `shouldBe` 5 -- 2 substitutions + 1 deletion, so we get (2 * 2) + 1 = 5++      prop "if arguments order is switched, the result is same when switching insert and delete cost" $+        \source target cost -> if cost > 0 then levenshteinWithCosts source target cost 1 1 == levenshteinWithCosts target source 1 cost 1 else True+++    -- ================================+    -- Tests for "levenshteinLessEqual"+    -- ================================+    context "levenshtein less equal" $ do+      prop "for all successful result, it should be less than maxD" $+        \source target maxD ->+          case levenshteinLessEqual source target maxD of+            Just d -> d <= maxD+            Nothing -> True++      prop "for all successful result, it should be equal to their levenstehin" $+        \source target maxD ->+          case levenshteinLessEqual source target maxD of+            Just d -> d == levenshtein source target+            Nothing -> True++      it "test on kitten and sitting example" $ do+        levenshteinLessEqual kitten sitting 3 `shouldBe` (Just 3)+        levenshteinLessEqual kitten sitting 2 `shouldBe` Nothing

@@ -0,0 +1,45 @@+module Main+  ( main )+  where++import qualified Criterion.Main as C+import qualified Test.Hspec as HS++import qualified LevenshteinSpec++import Data.FuzzyStrMatch.Levenshtein+import Test.Hspec.Runner+import Prelude++specs :: Spec+specs = do+  HS.describe "Run all tests" $ do+    LevenshteinSpec.spec++main :: IO ()+main = do+  summary <- hspecWithResult defaultConfig +    { configColorMode = ColorAuto+    } specs+  +  putStrLn $ "Total tests: " ++ show (summaryExamples summary)+  putStrLn $ "Failures: "    ++ show (summaryFailures summary)++  -- =========+  -- Benchmark:+  -- =========+  -- TODO: Use more examples, for now this will do+  let source = "aaaaaaaaaaaaaaaaaaaaaaaaaaaa"+      target = "abababababababababababababababababababababababababababab"++  -- We evaluate to normal form, because we want full evaluation+  C.defaultMain+    [+      -- According to bench mark, a full distance calculation time = ~225 us+      -- In comparison, bounded calculation time = ~50 us++      -- Hence proving that this exits early as soon as the bound hits, I+      -- believe the difference would be even larger for bigger strings+      C.bench "levenshtein" $ C.nf (levenshtein source) target+    , C.bench "levenshteinLessEqual" $ C.nf (levenshteinLessEqual source target) 3+    ]