fuzzyset 0.2.4 → 0.3.0
raw patch · 13 files changed
+1956/−1530 lines, 13 filesdep +mtldep +transformersdep −data-defaultdep ~hspecdep ~textdep ~text-metricsPVP ok
version bump matches the API change (PVP)
Dependencies added: mtl, transformers
Dependencies removed: data-default
Dependency ranges changed: hspec, text, text-metrics, unordered-containers, vector
API changes (from Hackage documentation)
- Data.FuzzySet: addToSet :: FuzzySet -> Text -> (FuzzySet, Bool)
- Data.FuzzySet: data FuzzySet
- Data.FuzzySet: defaultSet :: FuzzySet
- Data.FuzzySet: emptySet :: Int -> Int -> Bool -> FuzzySet
- Data.FuzzySet: fromList :: [Text] -> FuzzySet
- Data.FuzzySet: get :: FuzzySet -> Text -> [(Double, Text)]
- Data.FuzzySet: getOne :: FuzzySet -> Text -> Maybe Text
- Data.FuzzySet: getOneWithMinScore :: Double -> FuzzySet -> Text -> Maybe Text
- Data.FuzzySet: getWithMinScore :: Double -> FuzzySet -> Text -> [(Double, Text)]
- Data.FuzzySet: instance Data.Default.Class.Default Data.FuzzySet.Types.FuzzySet
- Data.FuzzySet.Internal: (|>) :: a -> (a -> b) -> b
- Data.FuzzySet.Internal: infixl 1 |>
- Data.FuzzySet.Types: FuzzySet :: !HashMap Text Text -> !HashMap Text [GramInfo] -> !HashMap Int (Vector FuzzySetItem) -> !Int -> !Int -> !Bool -> FuzzySet
- Data.FuzzySet.Types: FuzzySetItem :: !Double -> !Text -> FuzzySetItem
- Data.FuzzySet.Types: GramInfo :: !Int -> !Int -> GramInfo
- Data.FuzzySet.Types: [exactSet] :: FuzzySet -> !HashMap Text Text
- Data.FuzzySet.Types: [gramCount] :: GramInfo -> !Int
- Data.FuzzySet.Types: [gramSizeLower] :: FuzzySet -> !Int
- Data.FuzzySet.Types: [gramSizeUpper] :: FuzzySet -> !Int
- Data.FuzzySet.Types: [itemIndex] :: GramInfo -> !Int
- Data.FuzzySet.Types: [items] :: FuzzySet -> !HashMap Int (Vector FuzzySetItem)
- Data.FuzzySet.Types: [matchDict] :: FuzzySet -> !HashMap Text [GramInfo]
- Data.FuzzySet.Types: [normalizedEntry] :: FuzzySetItem -> !Text
- Data.FuzzySet.Types: [useLevenshtein] :: FuzzySet -> !Bool
- Data.FuzzySet.Types: [vectorMagnitude] :: FuzzySetItem -> !Double
- Data.FuzzySet.Types: data FuzzySet
- Data.FuzzySet.Types: data FuzzySetItem
- Data.FuzzySet.Types: data GramInfo
- Data.FuzzySet.Types: instance GHC.Classes.Eq Data.FuzzySet.Types.FuzzySet
- Data.FuzzySet.Types: instance GHC.Classes.Eq Data.FuzzySet.Types.FuzzySetItem
- Data.FuzzySet.Types: instance GHC.Classes.Eq Data.FuzzySet.Types.GramInfo
- Data.FuzzySet.Types: instance GHC.Show.Show Data.FuzzySet.Types.FuzzySet
- Data.FuzzySet.Types: instance GHC.Show.Show Data.FuzzySet.Types.FuzzySetItem
- Data.FuzzySet.Types: instance GHC.Show.Show Data.FuzzySet.Types.GramInfo
- Data.FuzzySet.Util: distance :: Text -> Text -> Double
- Data.FuzzySet.Util: enclosedIn :: Text -> Char -> Text
- Data.FuzzySet.Util: norm :: (Integral a, Floating b) => [a] -> b
- Data.FuzzySet.Util: normalized :: Text -> Text
- Data.FuzzySet.Util: substr :: Int -> Int -> Text -> Text
+ Data.FuzzySet: addMany_ :: MonadFuzzySearch m => [Text] -> m ()
+ Data.FuzzySet: add_ :: MonadFuzzySearch m => Text -> m ()
+ Data.FuzzySet: class (MonadState FuzzySet m) => MonadFuzzySearch m
+ Data.FuzzySet: closestMatch :: MonadFuzzySearch m => Text -> m (Maybe Text)
+ Data.FuzzySet: closestMatchMin :: MonadFuzzySearch m => Double -> Text -> m (Maybe Text)
+ Data.FuzzySet: data FuzzySearchT m a
+ Data.FuzzySet: find :: MonadFuzzySearch m => Text -> m [FuzzyMatch]
+ Data.FuzzySet: findMin :: MonadFuzzySearch m => Double -> Text -> m [FuzzyMatch]
+ Data.FuzzySet: findOne :: MonadFuzzySearch m => Text -> m (Maybe FuzzyMatch)
+ Data.FuzzySet: findOneMin :: MonadFuzzySearch m => Double -> Text -> m (Maybe FuzzyMatch)
+ Data.FuzzySet: runDefaultFuzzySearch :: FuzzySearch a -> a
+ Data.FuzzySet: runDefaultFuzzySearchT :: Monad m => FuzzySearchT m a -> m a
+ Data.FuzzySet: runFuzzySearch :: FuzzySearch a -> Int -> Int -> Bool -> a
+ Data.FuzzySet: runFuzzySearchT :: Monad m => FuzzySearchT m a -> Int -> Int -> Bool -> m a
+ Data.FuzzySet: type FuzzySearch = FuzzySearchT Identity
+ Data.FuzzySet.Internal: FuzzySet :: !HashMap Text Text -> !HashMap Text [GramInfo] -> !HashMap Int (Vector FuzzySetItem) -> !Int -> !Int -> !Bool -> FuzzySet
+ Data.FuzzySet.Internal: FuzzySetItem :: !Double -> !Text -> FuzzySetItem
+ Data.FuzzySet.Internal: GramInfo :: !Int -> !Int -> GramInfo
+ Data.FuzzySet.Internal: [exactSet] :: FuzzySet -> !HashMap Text Text
+ Data.FuzzySet.Internal: [gramCount] :: GramInfo -> !Int
+ Data.FuzzySet.Internal: [gramSizeLower] :: FuzzySet -> !Int
+ Data.FuzzySet.Internal: [gramSizeUpper] :: FuzzySet -> !Int
+ Data.FuzzySet.Internal: [itemIndex] :: GramInfo -> !Int
+ Data.FuzzySet.Internal: [items] :: FuzzySet -> !HashMap Int (Vector FuzzySetItem)
+ Data.FuzzySet.Internal: [matchDict] :: FuzzySet -> !HashMap Text [GramInfo]
+ Data.FuzzySet.Internal: [normalizedEntry] :: FuzzySetItem -> !Text
+ Data.FuzzySet.Internal: [useLevenshtein] :: FuzzySet -> !Bool
+ Data.FuzzySet.Internal: [vectorMagnitude] :: FuzzySetItem -> !Double
+ Data.FuzzySet.Internal: addMany_ :: MonadState FuzzySet m => [Text] -> m [Text]
+ Data.FuzzySet.Internal: add_ :: MonadState FuzzySet m => Text -> m Bool
+ Data.FuzzySet.Internal: data FuzzySet
+ Data.FuzzySet.Internal: data FuzzySetItem
+ Data.FuzzySet.Internal: data GramInfo
+ Data.FuzzySet.Internal: distance :: Text -> Text -> Double
+ Data.FuzzySet.Internal: instance GHC.Classes.Eq Data.FuzzySet.Internal.FuzzySet
+ Data.FuzzySet.Internal: instance GHC.Classes.Eq Data.FuzzySet.Internal.FuzzySetItem
+ Data.FuzzySet.Internal: instance GHC.Classes.Eq Data.FuzzySet.Internal.GramInfo
+ Data.FuzzySet.Internal: instance GHC.Show.Show Data.FuzzySet.Internal.FuzzySet
+ Data.FuzzySet.Internal: instance GHC.Show.Show Data.FuzzySet.Internal.FuzzySetItem
+ Data.FuzzySet.Internal: instance GHC.Show.Show Data.FuzzySet.Internal.GramInfo
+ Data.FuzzySet.Internal: norm :: [Int] -> Double
+ Data.FuzzySet.Internal: normalized :: Text -> Text
+ Data.FuzzySet.Internal: type FuzzyMatch = (Double, Text)
+ Data.FuzzySet.Monad: FuzzySearchT :: StateT FuzzySet m a -> FuzzySearchT m a
+ Data.FuzzySet.Monad: [getFuzzySearchT] :: FuzzySearchT m a -> StateT FuzzySet m a
+ Data.FuzzySet.Monad: add :: MonadFuzzySearch m => Text -> m Bool
+ Data.FuzzySet.Monad: addMany :: MonadFuzzySearch m => [Text] -> m [Text]
+ Data.FuzzySet.Monad: addMany_ :: MonadFuzzySearch m => [Text] -> m ()
+ Data.FuzzySet.Monad: add_ :: MonadFuzzySearch m => Text -> m ()
+ Data.FuzzySet.Monad: class (MonadState FuzzySet m) => MonadFuzzySearch m
+ Data.FuzzySet.Monad: closestMatch :: MonadFuzzySearch m => Text -> m (Maybe Text)
+ Data.FuzzySet.Monad: closestMatchMin :: MonadFuzzySearch m => Double -> Text -> m (Maybe Text)
+ Data.FuzzySet.Monad: find :: MonadFuzzySearch m => Text -> m [FuzzyMatch]
+ Data.FuzzySet.Monad: findMin :: MonadFuzzySearch m => Double -> Text -> m [FuzzyMatch]
+ Data.FuzzySet.Monad: findOne :: MonadFuzzySearch m => Text -> m (Maybe FuzzyMatch)
+ Data.FuzzySet.Monad: findOneMin :: MonadFuzzySearch m => Double -> Text -> m (Maybe FuzzyMatch)
+ Data.FuzzySet.Monad: instance (Data.FuzzySet.Monad.MonadFuzzySearch m, Control.Monad.State.Class.MonadState Data.FuzzySet.Internal.FuzzySet (Control.Monad.Trans.Select.SelectT s m)) => Data.FuzzySet.Monad.MonadFuzzySearch (Control.Monad.Trans.Select.SelectT s m)
+ Data.FuzzySet.Monad: instance (Data.FuzzySet.Monad.MonadFuzzySearch m, GHC.Base.Monoid w) => Data.FuzzySet.Monad.MonadFuzzySearch (Control.Monad.Trans.Writer.Lazy.WriterT w m)
+ Data.FuzzySet.Monad: instance Control.Monad.Fix.MonadFix m => Control.Monad.Fix.MonadFix (Data.FuzzySet.Monad.FuzzySearchT m)
+ Data.FuzzySet.Monad: instance Control.Monad.IO.Class.MonadIO m => Control.Monad.IO.Class.MonadIO (Data.FuzzySet.Monad.FuzzySearchT m)
+ Data.FuzzySet.Monad: instance Control.Monad.Trans.Class.MonadTrans Data.FuzzySet.Monad.FuzzySearchT
+ Data.FuzzySet.Monad: instance Data.FuzzySet.Monad.MonadFuzzySearch m => Data.FuzzySet.Monad.MonadFuzzySearch (Control.Monad.Trans.Cont.ContT r m)
+ Data.FuzzySet.Monad: instance Data.FuzzySet.Monad.MonadFuzzySearch m => Data.FuzzySet.Monad.MonadFuzzySearch (Control.Monad.Trans.Except.ExceptT e m)
+ Data.FuzzySet.Monad: instance Data.FuzzySet.Monad.MonadFuzzySearch m => Data.FuzzySet.Monad.MonadFuzzySearch (Control.Monad.Trans.Maybe.MaybeT m)
+ Data.FuzzySet.Monad: instance Data.FuzzySet.Monad.MonadFuzzySearch m => Data.FuzzySet.Monad.MonadFuzzySearch (Control.Monad.Trans.Reader.ReaderT r m)
+ Data.FuzzySet.Monad: instance Data.FuzzySet.Monad.MonadFuzzySearch m => Data.FuzzySet.Monad.MonadFuzzySearch (Control.Monad.Trans.State.Lazy.StateT Data.FuzzySet.Internal.FuzzySet m)
+ Data.FuzzySet.Monad: instance GHC.Base.Functor m => GHC.Base.Functor (Data.FuzzySet.Monad.FuzzySearchT m)
+ Data.FuzzySet.Monad: instance GHC.Base.Monad m => Control.Monad.State.Class.MonadState Data.FuzzySet.Internal.FuzzySet (Data.FuzzySet.Monad.FuzzySearchT m)
+ Data.FuzzySet.Monad: instance GHC.Base.Monad m => Data.FuzzySet.Monad.MonadFuzzySearch (Data.FuzzySet.Monad.FuzzySearchT m)
+ Data.FuzzySet.Monad: instance GHC.Base.Monad m => GHC.Base.Applicative (Data.FuzzySet.Monad.FuzzySearchT m)
+ Data.FuzzySet.Monad: instance GHC.Base.Monad m => GHC.Base.Monad (Data.FuzzySet.Monad.FuzzySearchT m)
+ Data.FuzzySet.Monad: isEmpty :: MonadFuzzySearch m => m Bool
+ Data.FuzzySet.Monad: newtype FuzzySearchT m a
+ Data.FuzzySet.Monad: runDefaultFuzzySearch :: FuzzySearch a -> a
+ Data.FuzzySet.Monad: runDefaultFuzzySearchT :: Monad m => FuzzySearchT m a -> m a
+ Data.FuzzySet.Monad: runFuzzySearch :: FuzzySearch a -> Int -> Int -> Bool -> a
+ Data.FuzzySet.Monad: runFuzzySearchT :: Monad m => FuzzySearchT m a -> Int -> Int -> Bool -> m a
+ Data.FuzzySet.Monad: size :: MonadFuzzySearch m => m Int
+ Data.FuzzySet.Monad: type FuzzySearch = FuzzySearchT Identity
+ Data.FuzzySet.Monad: values :: MonadFuzzySearch m => m [Text]
+ Data.FuzzySet.Simple: (>+<) :: FuzzySet -> Text -> FuzzySet
+ Data.FuzzySet.Simple: add :: Text -> FuzzySet -> FuzzySet
+ Data.FuzzySet.Simple: addMany :: [Text] -> FuzzySet -> FuzzySet
+ Data.FuzzySet.Simple: addManyToSet :: [Text] -> FuzzySet -> ([Text], FuzzySet)
+ Data.FuzzySet.Simple: addToSet :: Text -> FuzzySet -> (Bool, FuzzySet)
+ Data.FuzzySet.Simple: closestMatch :: Text -> FuzzySet -> Maybe Text
+ Data.FuzzySet.Simple: closestMatchMin :: Double -> Text -> FuzzySet -> Maybe Text
+ Data.FuzzySet.Simple: data FuzzySet
+ Data.FuzzySet.Simple: defaultSet :: FuzzySet
+ Data.FuzzySet.Simple: emptySet :: Int -> Int -> Bool -> FuzzySet
+ Data.FuzzySet.Simple: find :: Text -> FuzzySet -> [FuzzyMatch]
+ Data.FuzzySet.Simple: findMin :: Double -> Text -> FuzzySet -> [FuzzyMatch]
+ Data.FuzzySet.Simple: findOne :: Text -> FuzzySet -> Maybe FuzzyMatch
+ Data.FuzzySet.Simple: findOneMin :: Double -> Text -> FuzzySet -> Maybe FuzzyMatch
+ Data.FuzzySet.Simple: fromList :: [Text] -> FuzzySet
+ Data.FuzzySet.Simple: infixl 4 >+<
+ Data.FuzzySet.Simple: isEmpty :: FuzzySet -> Bool
+ Data.FuzzySet.Simple: size :: FuzzySet -> Int
+ Data.FuzzySet.Simple: type FuzzyMatch = (Double, Text)
+ Data.FuzzySet.Simple: values :: FuzzySet -> [Text]
+ Data.FuzzySet.Utils: (<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
+ Data.FuzzySet.Utils: (<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
+ Data.FuzzySet.Utils: enclosedIn :: Text -> Char -> Text
+ Data.FuzzySet.Utils: infixr 8 <$$$>
+ Data.FuzzySet.Utils: safeHead :: [a] -> Maybe a
+ Data.FuzzySet.Utils: substr :: Int -> Int -> Text -> Text
- Data.FuzzySet: add :: FuzzySet -> Text -> FuzzySet
+ Data.FuzzySet: add :: MonadFuzzySearch m => Text -> m Bool
- Data.FuzzySet: addMany :: FuzzySet -> [Text] -> FuzzySet
+ Data.FuzzySet: addMany :: MonadFuzzySearch m => [Text] -> m [Text]
- Data.FuzzySet: isEmpty :: FuzzySet -> Bool
+ Data.FuzzySet: isEmpty :: MonadFuzzySearch m => m Bool
- Data.FuzzySet: size :: FuzzySet -> Int
+ Data.FuzzySet: size :: MonadFuzzySearch m => m Int
- Data.FuzzySet: values :: FuzzySet -> [Text]
+ Data.FuzzySet: values :: MonadFuzzySearch m => m [Text]
- Data.FuzzySet.Internal: getMatches :: FuzzySet -> Text -> Double -> Int -> [(Double, Text)]
+ Data.FuzzySet.Internal: getMatches :: FuzzySet -> Text -> Double -> Int -> [FuzzyMatch]
Files
- LICENSE +1/−1
- README.md +26/−47
- fuzzyset.cabal +37/−23
- src/Data/FuzzySet.hs +157/−440
- src/Data/FuzzySet/Internal.hs +177/−118
- src/Data/FuzzySet/Monad.hs +251/−0
- src/Data/FuzzySet/Simple.hs +348/−0
- src/Data/FuzzySet/Types.hs +0/−34
- src/Data/FuzzySet/Util.hs +0/−81
- src/Data/FuzzySet/Utils.hs +30/−0
- src/Main.hs +20/−0
- test/Helpers.hs +10/−14
- test/Spec.hs +899/−772
LICENSE view
@@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2017-2022, Heikki Johannes Hildén+Copyright (c) 2017-present, Heikki Johannes Hildén All rights reserved. Redistribution and use in source and binary forms, with or without
README.md view
@@ -1,60 +1,39 @@-# fuzzyset [](https://github.com/laserpants/fuzzyset-haskell/actions/workflows/haskell.yml) [](https://opensource.org/licenses/BSD-3-Clause) [](https://www.haskell.org/) [](http://hackage.haskell.org/package/fuzzyset)--A fuzzy string set data structure for approximate string matching. --## Examples--```haskell-{-# LANGUAGE OverloadedStrings #-}-module Main where--import Data.FuzzySet+# fuzzyset-haskell -states = [ "Alabama" , "Alaska" , "American Samoa" , "Arizona" , "Arkansas"- , "California" , "Colorado" , "Connecticut" , "Delaware" , "District of Columbia"- , "Florida" , "Georgia" , "Guam" , "Hawaii" , "Idaho"- , "Illinois" , "Indiana" , "Iowa" , "Kansas" , "Kentucky"- , "Louisiana" , "Maine" , "Maryland" , "Massachusetts" , "Michigan"- , "Minnesota" , "Mississippi" , "Missouri" , "Montana" , "Nebraska"- , "Nevada" , "New Hampshire" , "New Jersey" , "New Mexico" , "New York"- , "North Carolina" , "North Dakota" , "Northern Marianas Islands" , "Ohio" , "Oklahoma"- , "Oregon" , "Pennsylvania" , "Puerto Rico" , "Rhode Island" , "South Carolina"- , "South Dakota" , "Tennessee" , "Texas" , "Utah" , "Vermont"- , "Virginia" , "Virgin Islands" , "Washington" , "West Virginia" , "Wisconsin"- , "Wyoming" ]+[](https://opensource.org/licenses/BSD-3-Clause)+[](https://www.haskell.org/)+[](http://hackage.haskell.org/package/fuzzyset) -statesSet = fromList states+A fuzzy string set data structure for approximate string matching. -main = mapM_ print (get statesSet "Burger Islands")-```+In a nutshell: -The output of this program is:+1. Add data to the set (see `add`, `add_`, `addMany`, and `addMany_`)+2. Query the set (see `find`, `findMin`, `findOne`, `findOneMin`, `closestMatchMin`, and `closestMatch`) -```haskell-(0.7142857142857143,"Virgin Islands")-(0.5714285714285714,"Rhode Island")-(0.44,"Northern Marianas Islands")-(0.35714285714285715,"Maryland")-```+Refer to the [Haddock docs](http://hackage.haskell.org/package/fuzzyset) for details. -Using the same definition of `statesSet` from previous example:+## Example ```haskell->>> get statesSet "Why-oh-me-ing"-[(0.5384615384615384,"Wyoming")]-->>> get statesSet "Connect a cat"-[(0.6923076923076923,"Connecticut")]+{-# LANGUAGE OverloadedStrings #-}+module Main where ``` ->>> get statesSet "Transylvania"-[(0.75,"Pennsylvania"),(0.3333333333333333,"California"),(0.3333333333333333,"Arkansas"),(0.3333333333333333,"Kansas")]+import Control.Monad.Trans.Class (lift)+import Data.Text (Text)+import Data.FuzzySet (FuzzySearchT, add_, closestMatch, runDefaultFuzzySearchT) ->>> get statesSet "CanOfSauce"-[(0.4,"Kansas")]+findMovie :: Text -> FuzzySearchT IO (Maybe Text)+findMovie = closestMatch ->>> get statesSet "Alaska"-[(1.0,"Alaska")]+prog :: FuzzySearchT IO ()+prog = do+ add_ "Jurassic Park"+ add_ "Terminator"+ add_ "The Matrix"+ result <- findMovie "The Percolator"+ lift (print result) ->>> get statesSet "Alaskanbraskansas"-[(0.47058823529411764,"Arkansas"),(0.35294117647058826,"Kansas"),(0.35294117647058826,"Alaska"),(0.35294117647058826,"Alabama"),(0.35294117647058826,"Nebraska")]+main :: IO ()+main = runDefaultFuzzySearchT prog ```
fuzzyset.cabal view
@@ -1,41 +1,52 @@-cabal-version: 1.12+cabal-version: 2.2 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.35.1. -- -- see: https://github.com/sol/hpack name: fuzzyset-version: 0.2.4-synopsis: Fuzzy set for approximate string matching-description: This library is based on the Python and JavaScript libraries with similar names.+version: 0.3.0+synopsis: Fuzzy set data structure for approximate string matching+description: Please see the README on GitHub at <https://github.com/laserpants/fuzzyset-haskell#readme> category: Data-homepage: https://github.com/laserpants/fuzzyset-haskell-author: Johannes Hildén+homepage: https://github.com/laserpants/fuzzyset-haskell#readme+bug-reports: https://github.com/laserpants/fuzzyset-haskell/issues+author: Heikki Johannes Hildén maintainer: hildenjohannes@gmail.com-copyright: 2017-2023 Johannes Hildén-license: BSD3+copyright: 2017-present laserpants+license: BSD-3-Clause license-file: LICENSE build-type: Simple extra-source-files: README.md +source-repository head+ type: git+ location: https://github.com/laserpants/fuzzyset-haskell+ library exposed-modules: Data.FuzzySet Data.FuzzySet.Internal- Data.FuzzySet.Types- Data.FuzzySet.Util+ Data.FuzzySet.Monad+ Data.FuzzySet.Simple+ Data.FuzzySet.Utils+ Main other-modules: Paths_fuzzyset+ autogen-modules:+ Paths_fuzzyset hs-source-dirs: src+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: base >=4.7 && <5- , data-default >=0.7.1.1 && <0.8- , text >=1.2.3.1 && <2.1- , text-metrics >=0.3.0 && <0.4- , unordered-containers >=0.2.10.0 && <0.3- , vector >=0.12.0.3 && <0.14+ , mtl >=2.2.2 && <2.4.0+ , text >=2.0.2 && <2.1.0+ , text-metrics >=0.3.2 && <0.4.0+ , transformers >=0.5.6.2 && <0.7.0.0+ , unordered-containers >=0.2.19.1 && <0.3.0.0+ , vector >=0.13.0.0 && <0.14.0.0 default-language: Haskell2010 test-suite fuzzyset-test@@ -44,17 +55,20 @@ other-modules: Helpers Paths_fuzzyset+ autogen-modules:+ Paths_fuzzyset hs-source-dirs: test- ghc-options: -threaded -rtsopts -with-rtsopts=-N+ ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.7 && <5- , data-default >=0.7.1.1 && <0.8 , fuzzyset- , hspec >=2.7.1 && <2.11+ , hspec >=2.10.10 && <2.12 , ieee754 >=0.8.0 && <0.9- , text >=1.2.3.1 && <2.1- , text-metrics >=0.3.0 && <0.4- , unordered-containers >=0.2.10.0 && <0.3- , vector >=0.12.0.3 && <0.14+ , mtl >=2.2.2 && <2.4.0+ , text >=2.0.2 && <2.1.0+ , text-metrics >=0.3.2 && <0.4.0+ , transformers >=0.5.6.2 && <0.7.0.0+ , unordered-containers >=0.2.19.1 && <0.3.0.0+ , vector >=0.13.0.0 && <0.14.0.0 default-language: Haskell2010
src/Data/FuzzySet.hs view
@@ -1,482 +1,199 @@-{-# LANGUAGE RecordWildCards #-}- -- | -- -- Module : Data.FuzzySet--- Copyright : (c) 2017-2019 Johannes Hildén+-- Copyright : (c) 2017-present Heikki Johannes Hildén -- License : BSD3 -- Maintainer : hildenjohannes@gmail.com -- Stability : experimental -- Portability : GHC ----- A fuzzy string set data structure for approximate string matching. This--- implementation is based on the Python and JavaScript libraries with similar--- names; [fuzzyset.js](http://glench.github.io/fuzzyset.js/), and the original--- [fuzzyset](https://github.com/axiak/fuzzyset) Python library.- module Data.FuzzySet- (- -- * How to use this library+ (+ -- * Getting started -- $howto - -- * Types- FuzzySet-- -- * API-- -- ** Initializing- , emptySet- , defaultSet- , fromList-- -- ** Adding- , add- , addToSet- , addMany+ -- * FuzzySearch monad+ FuzzySearch+ , MonadFuzzySearch+ , runFuzzySearch+ , runDefaultFuzzySearch - -- ** Retrieving- , get- , getWithMinScore- , getOne- , getOneWithMinScore+ -- * FuzzySearch monad transformer+ , FuzzySearchT+ , runFuzzySearchT+ , runDefaultFuzzySearchT - -- ** Inspecting- , size- , isEmpty- , values+ -- * Insertion+ , add+ , add_+ , addMany+ , addMany_ - -- * Implementation- -- $implementation+ -- * Lookup+ , find+ , findMin+ , findOne+ , findOneMin+ , closestMatchMin+ , closestMatch - ) where+ -- * Inspection+ , values+ , size+ , isEmpty+ ) where -import Data.Default (Default, def)-import Data.FuzzySet.Internal-import Data.FuzzySet.Types-import Data.FuzzySet.Util-import Data.HashMap.Strict (HashMap, elems, insert)-import Data.List (find)-import Data.Maybe (fromMaybe)-import Data.Text (Text)-import Data.Vector (snoc)-import qualified Data.FuzzySet.Util as Util-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Text as Text-import qualified Data.Vector as Vector+import Data.FuzzySet.Monad+ ( MonadFuzzySearch+ , FuzzySearchT(..)+ , FuzzySearch+ , runDefaultFuzzySearchT+ , runFuzzySearchT+ , runFuzzySearch+ , runDefaultFuzzySearch+ , add+ , add_+ , addMany+ , addMany_+ , find+ , findOne+ , findOneMin+ , closestMatch+ , findMin+ , closestMatchMin+ , isEmpty+ , size+ , values+ ) -- $howto ----- Make sure the @OverloadedStrings@ pragma is enabled. After that, three steps--- are typically involved:------ 1. Create a set using one of 'defaultSet', 'emptySet', or 'fromList'.--- 2. To add entries, use 'add', 'addToSet', or 'addMany'.--- 3. Query the set with 'get', 'getOne', 'getWithMinScore', or 'getOneWithMinScore'.+-- This library provides two similar, but independent APIs. The "Data.FuzzySet.Simple"+-- module offers a simpler (pure) interface for working with the t'FuzzySet' data+-- structure directly (similar to earlier versions of the library). A+-- disadvantage of this approach is that it scales poorly when the code involves+-- IO, and possibly other effects. For most real-world use cases, it is+-- therefore recommended to use the default API and the t'FuzzySearch' monad+-- exposed by "Data.FuzzySet" (see below for more examples). ----- >>> defaultSet `add` "Jurassic Park" `add` "Terminator" `add` "The Matrix" `getOne` "percolator"--- Just "Terminator"+-- > findPlanet :: (MonadIO m, MonadFuzzySearch m) => Text -> m ()+-- > findPlanet planetName = do+-- > addMany_ [ "Mercury", "Venus", "Earth", "Mars", "Jupiter", "Saturn", "Uranus", "Neptune" ]+-- > findOne planetName >>= liftIO . print ----- >>> defaultSet `add` "Shaggy Rogers" `add` "Fred Jones" `add` "Daphne Blake" `add` "Velma Dinkley" `get` "Shaggy Jones"--- [(0.7692307692307693,"Shaggy Rogers"),(0.5,"Fred Jones")]+-- >>> runDefaultFuzzySearchT (findPlanet "Joopiter")+-- Just (0.75,"Jupiter") ----- There are also a few functions to inspect sets: 'size', 'isEmpty', and 'values'.+-- Note that all strings are represented as [text](https://hackage.haskell.org/package/text)+-- values. Examples on this page use the @OverloadedStrings@ language extension+-- to allow string literals to be translated into this form. ----- == More examples+-- Import the main module: ----- > {-# LANGUAGE OverloadedStrings #-}--- > module Main where--- > -- > import Data.FuzzySet--- >--- > states = [ "Alabama" , "Alaska" , "American Samoa" , "Arizona" , "Arkansas"--- > , "California" , "Colorado" , "Connecticut" , "Delaware" , "District of Columbia"--- > , "Florida" , "Georgia" , "Guam" , "Hawaii" , "Idaho"--- > , "Illinois" , "Indiana" , "Iowa" , "Kansas" , "Kentucky"--- > , "Louisiana" , "Maine" , "Maryland" , "Massachusetts" , "Michigan"--- > , "Minnesota" , "Mississippi" , "Missouri" , "Montana" , "Nebraska"--- > , "Nevada" , "New Hampshire" , "New Jersey" , "New Mexico" , "New York"--- > , "North Carolina" , "North Dakota" , "Northern Marianas Islands" , "Ohio" , "Oklahoma"--- > , "Oregon" , "Pennsylvania" , "Puerto Rico" , "Rhode Island" , "South Carolina"--- > , "South Dakota" , "Tennessee" , "Texas" , "Utah" , "Vermont"--- > , "Virginia" , "Virgin Islands" , "Washington" , "West Virginia" , "Wisconsin"--- > , "Wyoming" ]--- >--- > statesSet = fromList states--- >--- > main = mapM_ print (get statesSet "Burger Islands") ----- The output of this program is:------ > (0.7142857142857143,"Virgin Islands")--- > (0.5714285714285714,"Rhode Island")--- > (0.44,"Northern Marianas Islands")--- > (0.35714285714285715,"Maryland")------ Using the definition of @statesSet@ from previous example:------ > >>> get statesSet "Why-oh-me-ing"--- > [(0.5384615384615384,"Wyoming")]------ > >>> get statesSet "Connect a cat"--- > [(0.6923076923076923,"Connecticut")]------ > >>> get statesSet "Transylvania"--- > [(0.75,"Pennsylvania"),(0.3333333333333333,"California"),(0.3333333333333333,"Arkansas"),(0.3333333333333333,"Kansas")]------ > >>> get statesSet "CanOfSauce"--- > [(0.4,"Kansas")]------ > >>> get statesSet "Alaska"--- > [(1.0,"Alaska")]------ > >>> get statesSet "Alaskanbraskansas"--- > [(0.47058823529411764,"Arkansas"),(0.35294117647058826,"Kansas"),(0.35294117647058826,"Alaska"),(0.35294117647058826,"Alabama"),(0.35294117647058826,"Nebraska")]------ $implementation------ To determine the similarity between entries of the set and the search string,--- the algorithm translates the strings to vectors and then calculates a metric--- known as the /cosine similarity/ between these. A detailed explanation, with--- interactive examples, can be found on the website for the--- [JavaScript version](http://glench.github.io/fuzzyset.js/ui/) of this library.--- A brief overview follows here.------ == Cosine similarity------ The cosine similarity of two vectors \(A\) and \(B\) is given by the formula------ \[ \frac{A \cdot B}{||A||\ ||B||} \]------ where \(A \cdot B\) is the dot product of the two vectors, and \(||A||\)--- denotes the [euclidean norm](Data-FuzzySet-Util.html#v:norm), or /magnitude/,--- of \(A\). The cosine similarity is a measure of the (cosine of the) angle--- between two vectors. Since we will only deal with vectors with non-negative--- components, the result of this operation is always in the range \([0, 1]\).------ == Gram vectors------ The vector we are interested in has as its components the number of times--- a gram (substring) occurs in the (normalized version of the) string. The--- function 'gramVector' takes an arbitrary string as input and returns this--- vector, in dictionary form:------ >>> gramVector "Mississippi" 3--- fromList [("pi-",1),("ssi",2),("sis",1),("iss",2),("-mi",1),("mis",1),("sip",1),("ppi",1),("ipp",1)]------ This dictionary maps each /n/-gram key to to the number of times it occurs--- in the string. The below table makes it more evident that this can be thought--- of as a sparse vector.------ +---------+-------+-------+-------+-------+-------+-------+-------+-------+-------+--- | /Gram/ | @-mi@ | @mis@ | @iss@ | @ssi@ | @sis@ | @sip@ | @ipp@ | @ppi@ | @pi-@ |--- +---------+-------+-------+-------+-------+-------+-------+-------+-------+-------+--- | /Count/ | 1 | 1 | 2 | 2 | 1 | 1 | 1 | 1 | 1 |--- +---------+-------+-------+-------+-------+-------+-------+-------+-------+-------+------ == Lookup------ The 'FuzzySet' data structure maintains a dictionary with all /n/-grams that--- occur in the entries of the set for different sizes of grams.------ > "mis" => [ { itemIndex = 4, gramCount = 1 }, { itemIndex = 11, gramCount = 2 } ]------ To compute the cosine similarity score, the function 'Data.FuzzySet.Internal.getMatches'--- queries the set for the grams that stem from the search string. Here is an--- example: Let's say we have a set where the string @"coffee"@ appears, and--- want to search for the string @"covfefe"@. The two strings translate to the--- following /bigram/ vectors:------ >>> gramVector "coffee" 2--- fromList [("e-",1),("ff",1),("of",1),("co",1),("ee",1),("fe",1),("-c",1)]--- >>> gramVector "covfefe" 2--- fromList [("e-",1),("vf",1),("ef",1),("ov",1),("co",1),("fe",2),("-c",1)]------ +------------------------------------------------+------------------------------------------------+--- | /coffee/ | /covfefe/ |--- +------+------+------+------+------+------+------+------+------+------+------+------+------+------+--- | @-c@ | @co@ | @of@ | @ff@ | @fe@ | @ee@ | @e-@ | @-c@ | @co@ | @ov@ | @vf@ | @fe@ | @e-@ | @e-@ |--- +------+------+------+------+------+------+------+------+------+------+------+------+------+------+--- | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 1 | 2 | 1 | 1 |--- +------+------+------+------+------+------+------+------+------+------+------+------+------+------+------ The non-zero entries common to both vectors are then:------ +---------+------+------+------+------+--- | | @-c@ | @co@ | @fe@ | @e-@ |--- +---------+------+------+------+------+--- | \(a_i\) | 1 | 1 | 1 | 1 |--- +---------+------+------+------+------+--- | \(b_i\) | 1 | 1 | 2 | 1 |--- +---------+------+------+------+------+------ Dotting these we get \(1 \times 1 + 1 \times 1 + 1 \times 2 + 1 \times 1 = 5 \).--- The function 'matches' computes these dot products and returns a dictionary--- with the matched indices as keys. If the entry appears at item index, say,--- 3 in the set's internal list, this would yield a key-value pair @(3, 5)@ in--- the map.------ >>> matches (defaultSet `add` "tea" `add` "biscuits" `add` "cake" `add` "coffee") (gramVector "covfefe" 2)--- fromList [(2,2),(3,5)]------ We now have the numerators of the cosine similarity scores. The data--- structure keeps track of the magnitudes of the set entries, so we just need--- to look this quantity up using the index:------ > {vectorMagnitude = 2.6457513110645907, normalizedEntry = "coffee"}------ Multiplying this by the magnitude of the search string's vector,------ >>> norm $ elems $ gramVector "covfefe" 2--- 3.1622776601683795------ … we get 8.366600265340756, which is the denominator of the expression.--- So the similarity score for this entry of the set is------ >>> 5/(3.1622776601683795 * 2.6457513110645907)--- 0.5976143046671968------ And indeed, this is the score we get if the 'FuzzySet' is initialized with--- the Levenshtein option set to @False@:------ >>> (emptySet 2 3 False `add` "tea" `add` "biscuits" `add` "cake" `add` "coffee") `get` "covfefe"--- [(0.5976143046671968,"coffee")]------ Note that the above procedure is repeated for each gram size (starting with--- the highest) in the selected range, until we either get some results, or all--- sizes have been exhausted.------ Finally, if the set was initialized with the Levenshtein distance option--- enabled (e.g., using 'defaultSet'), then only the first 50 results are kept--- and a new score is computed based on the Levenshtein 'Data.FuzzySet.Util.distance'.-------- | Initialize an empty 'FuzzySet'.----emptySet- :: Int- -- ^ Lower bound on gram sizes to use (inclusive)- -> Int- -- ^ Upper bound on gram sizes to use (inclusive)- -> Bool- -- ^ Whether or not to use the [Levenshtein distance](https://people.cs.pitt.edu/~kirk/cs1501/Pruhs/Spring2006/assignments/editdistance/Levenshtein%20Distance.htm)- -- to determine the score- -> FuzzySet- -- ^ An empty fuzzy string set-emptySet =- FuzzySet mempty mempty mempty----- | An empty 'FuzzySet' with the following defaults:------ * Gram size lower: @2@--- * Gram size upper: @3@--- * Use Levenshtein distance: @True@----defaultSet :: FuzzySet-defaultSet =- emptySet 2 3 True----- | See 'defaultSet'.----instance Default FuzzySet where- def = defaultSet----- | Try to match a string against the entries in the set, and return a list of--- all results with a score greater than or equal to the specified minimum score--- (i.e., the first argument). The results are ordered by similarity score, with--- the closest match first.+-- Fuzzy search involves three types of operations: ---getWithMinScore- :: Double- -- ^ A minimum score- -> FuzzySet- -- ^ The fuzzy string set to compare the string against- -> Text- -- ^ The string to search for- -> [( Double, Text )]- -- ^ A list of results (score and matched value)-getWithMinScore- minScore- set@FuzzySet{ gramSizeLower = lower, gramSizeUpper = upper, .. }- value =- case key `HashMap.lookup` exactSet of- Just match ->- [( 1, match )]-- Nothing ->- sizes- |> fmap (getMatches set key minScore)- |> find (not . null)- |> fromMaybe []- where- key = Text.toLower value- sizes = reverse (enumFromTo lower upper)----- | Try to match the given string against the entries in the set, using a--- minimum score of 0.33. Return a list of results ordered by similarity score,--- with the closest match first. Use 'getWithMinScore' to specify a different--- threshold value.+-- * __Insertion:__ For adding entries to the set, see `add`, `add_`, `addMany`, and `addMany_`.+-- * __Lookup:__ To match a string against all values of the set, use `find`, `findMin`, `findOne`, `findOneMin`, `closestMatchMin`, and `closestMatch`.+-- * __Inspection:__ The function `values` returns all strings currently in the set. `size` and `isEmpty` are mostly self-explanatory. ---get- :: FuzzySet- -- ^ The fuzzy string set to compare the string against- -> Text- -- ^ The string to search for- -> [( Double, Text )]- -- ^ A list of results (score and matched value)-get =- getWithMinScore 0.33----- | Try to match the given string against the entries in the set using the--- specified minimum score and return the closest match, if one is found.+-- Finally, use `runFuzzySearch`, `runDefaultFuzzySearch`, `runFuzzySearchT`, or `runDefaultFuzzySearchT`+-- to get the result of the computation from the monad. ---getOneWithMinScore- :: Double- -- ^ A minimum score- -> FuzzySet- -- ^ The fuzzy string set to compare the string against- -> Text- -- ^ The string to search for- -> Maybe Text- -- ^ The closest match, if one is found-getOneWithMinScore minScore fuzzySet value =- case getWithMinScore minScore fuzzySet value of- [] ->- Nothing-- head : _ ->- Just (snd head)----- | Try to match the given string against the entries in the set, and return--- the closest match, if one is found. A minimum score of 0.33 is used. To--- specify a different threshold value, instead use 'getOneWithMinScore'.+-- === Simple search example ---getOne :: FuzzySet- -- ^ The fuzzy string set to compare the string against- -> Text- -- ^ The string to search for- -> Maybe Text- -- ^ The closest match, if one is found-getOne =- getOneWithMinScore 0.33----- | Add an entry to the set, or do nothing if a key that matches the string--- already exists in the set.+-- The following is a simple program to serve as a 'Hello World' example: ---add- :: FuzzySet- -- ^ Set to add the string to- -> Text- -- ^ The new entry- -> FuzzySet- -- ^ An updated set-add fuzzySet =- fst . addToSet fuzzySet----- | Add an entry, unless it is already present in the set. A pair is returned--- with the new set and a boolean which denotes whether or not anything was--- inserted.+-- > {-# LANGUAGE OverloadedStrings #-}+-- > module Main where+-- >+-- > import Data.Text (Text)+-- > import Data.FuzzySet (FuzzySearch, add_, closestMatch, runDefaultFuzzySearch)+-- >+-- > findMovie :: Text -> FuzzySearch (Maybe Text)+-- > findMovie title = do+-- > add_ "Jurassic Park"+-- > add_ "Terminator"+-- > add_ "The Matrix"+-- > closestMatch title+-- >+-- > main :: IO ()+-- > main = do+-- > let result = runDefaultFuzzySearch (findMovie "The Percolator")+-- > print result ---addToSet- :: FuzzySet- -- ^ Fuzzy string set to add the entry to- -> Text- -- ^ The new entry- -> ( FuzzySet, Bool )- -- ^ The updated set and a boolean, which will be 'True' if, and only if,- -- the value was not already in the set-addToSet set@FuzzySet{ gramSizeLower = lower, gramSizeUpper = upper, .. } value- | key `elem` exactSet =- ( set, False )- | otherwise =- ( newSet |> updateExactSet value, True )- where- newSet = foldr addSize set (enumFromTo lower upper)- key = Text.toLower value-- addSize :: Int -> FuzzySet -> FuzzySet- addSize gramSize FuzzySet{..} =- let- item = FuzzySetItem (elems grams |> Util.norm) key- in- FuzzySet{ items = items |> insert gramSize (itemVector `snoc` item)- , matchDict = grams |> HashMap.foldrWithKey updateDict matchDict- , .. }- where- updateDict gram count =- let- info = GramInfo (Vector.length itemVector) count- in- HashMap.alter (\maybeInfos -> Just $ info : fromMaybe [] maybeInfos) gram-- itemVector =- items- |> HashMap.lookup gramSize- |> fromMaybe Vector.empty- grams =- gramVector key gramSize-- updateExactSet :: Text -> FuzzySet -> FuzzySet- updateExactSet value FuzzySet{..} =- FuzzySet{ exactSet = exactSet |> insert key value- , .. }----- | Add a list of entries to the set, in one go.+-- The output of this program is: ----- @addMany = foldr (flip add)@+-- > Just "Terminator" ---addMany :: FuzzySet -> [Text] -> FuzzySet-addMany =- foldr (flip add)----- | Create a set from a list of entries, using the default settings.+-- === Adding IO ----- @fromList = addMany defaultSet@+-- Changing the previous example to instead use the `FuzzySearchT` transformer,+-- we can combine the search monad with IO and other effects. ---fromList :: [Text] -> FuzzySet-fromList =- addMany defaultSet----- | Return the number of entries in the set.+-- > {-# LANGUAGE OverloadedStrings #-}+-- > module Main where+-- >+-- > import Control.Monad.Trans.Class (lift)+-- > import Data.Text (Text)+-- > import Data.FuzzySet (FuzzySearchT, add_, closestMatch, runDefaultFuzzySearchT)+-- >+-- > findMovie :: Text -> FuzzySearchT IO (Maybe Text)+-- > findMovie = closestMatch+-- >+-- > prog :: FuzzySearchT IO ()+-- > prog = do+-- > add_ "Jurassic Park"+-- > add_ "Terminator"+-- > add_ "The Matrix"+-- > result <- findMovie "The Percolator"+-- > lift (print result)+-- >+-- > main :: IO ()+-- > main = runDefaultFuzzySearchT prog ----- >>> size (defaultSet `add` "map" `add` "cap")--- 2--- >>> size (defaultSet `add` "bork" `add` "bork" `add` "bork")--- 1+-- To make the search more restrictive, we can set a custom min score: ---size :: FuzzySet -> Int-size =- HashMap.size . exactSet----- | Return a boolean indicating whether the set is empty.+-- > findMovie :: Text -> FuzzySearchT IO (Maybe Text)+-- > findMovie = closestMatchMin 0.8 ----- >>> isEmpty (fromList [])--- True--- >>> isEmpty $ fromList ["Aramis", "Porthos", "Athos"]--- False+-- The output is now: ---isEmpty :: FuzzySet -> Bool-isEmpty =- HashMap.null . exactSet----- | Return the elements of the set. No particular order is guaranteed.+-- > Nothing ----- >>> values (fromList ["bass", "craze", "space", "lace", "daze", "haze", "ace", "maze"])--- ["space","daze","bass","maze","ace","craze","lace","haze"]+-- === Another example: Favorite fruit ---values :: FuzzySet -> [Text]-values =- elems . exactSet+-- > {-# LANGUAGE OverloadedStrings #-}+-- > module Main where+-- >+-- > import Control.Monad (when)+-- > import Control.Monad.IO.Class (liftIO)+-- > import Data.FuzzySet+-- > import Data.Text (Text, pack, unpack)+-- > import qualified Data.Text as Text+-- >+-- > repl :: FuzzySearchT IO ()+-- > repl = do+-- > str <- liftIO $ do+-- > putStrLn "Enter your favorite fruit below, or type \".exit\"."+-- > putStr "> "+-- > getLine+-- > when (str /= ".exit") $ do+-- > result <- findOneMin 0.6 (pack str)+-- > liftIO $ case result of+-- > Nothing ->+-- > putStrLn "I don't know that fruit."+-- > Just (1, match) ->+-- > putStrLn ("You like " <> unpack (Text.toLower match) <> ". Me too!")+-- > Just (_, match) ->+-- > putStrLn ("Did you mean \"" <> unpack match <> "\"?")+-- > repl+-- >+-- > main :: IO ()+-- > main = runDefaultFuzzySearchT $ do+-- > addMany_ fruits+-- > repl+-- >+-- > fruits :: [Text]+-- > fruits = [ "Apple", "Apricot", "Avocado", "Banana", "Bilberry", "Blackberry", "Blackcurrant", "Blueberry", "Boysenberry", "Currant", "Cherry", "Cherimoya", "Chico fruit", "Cloudberry", "Coconut", "Cranberry", "Cucumber", "Custard apple", "Damson", "Date", "Dragonfruit", "Durian", "Elderberry", "Feijoa", "Fig", "Goji berry", "Gooseberry", "Grape", "Raisin", "Grapefruit", "Guava", "Honeyberry", "Huckleberry", "Jabuticaba", "Jackfruit", "Jambul", "Jujube", "Juniper berry", "Kiwano", "Kiwifruit", "Kumquat", "Lemon", "Lime", "Loquat", "Longan", "Lychee", "Mango", "Mangosteen", "Marionberry", "Melon", "Cantaloupe", "Honeydew", "Watermelon", "Miracle fruit", "Mulberry", "Nectarine", "Nance", "Olive", "Orange", "Blood orange", "Clementine", "Mandarine", "Tangerine", "Papaya", "Passionfruit", "Peach", "Pear", "Persimmon", "Physalis", "Plantain", "Plum", "Prune", "Pineapple", "Plumcot", "Pomegranate", "Pomelo", "Purple mangosteen", "Quince", "Raspberry", "Salmonberry", "Rambutan", "Redcurrant", "Salal berry", "Salak", "Satsuma", "Soursop", "Star fruit", "Solanum quitoense", "Strawberry", "Tamarillo", "Tamarind", "Ugli fruit", "Yuzu" ]
src/Data/FuzzySet/Internal.hs view
@@ -1,117 +1,152 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-} --- The code in this module is responsible for querying a set for possible--- matches and determining how similar the string is to each candidate match.---- module Data.FuzzySet.Internal- ( (|>)- , matches- , getMatches- , gramVector- , grams- ) where+ ( FuzzySet(..)+ , FuzzySetItem(..)+ , GramInfo(..)+ , FuzzyMatch+ , grams+ , gramVector+ , matches+ , getMatches+ , add_+ , addMany_+ , normalized+ , norm+ , distance+ ) where +import Control.Monad.State (MonadState, get, modify)+import Data.Bifunctor (second)+import Data.Char (isAlphaNum, isSpace)+import Data.Foldable (traverse_) import Data.Function ((&))-import Data.FuzzySet.Types-import Data.FuzzySet.Util (distance)-import Data.FuzzySet.Util (norm)-import Data.FuzzySet.Util (normalized, substr, enclosedIn)-import Data.HashMap.Strict (HashMap, elems, foldrWithKey, lookup, lookupDefault, alter)+import Data.FuzzySet.Utils (enclosedIn, substr, (<$$>))+import Data.HashMap.Strict (HashMap, elems, foldrWithKey, insert, insertWith, lookup, lookupDefault)+import qualified Data.HashMap.Strict as HashMap import Data.List (sortBy) import Data.Maybe (fromMaybe) import Data.Ord (Down(..), comparing) import Data.Text (Text)-import Data.Vector ((!?))-import qualified Data.FuzzySet.Util as Util-import qualified Data.HashMap.Strict as HashMap import qualified Data.Text as Text+import Data.Text.Metrics (levenshteinNorm)+import Data.Vector (Vector, (!?))+import qualified Data.Vector as Vector+import Prelude hiding (lookup) +data FuzzySetItem = FuzzySetItem+ { vectorMagnitude :: !Double+ , normalizedEntry :: !Text+ } deriving (Eq, Show) --- | Alternative syntax for the reverse function application operator @(&)@,--- known also as the /pipe/ operator.----(|>) :: a -> (a -> b) -> b-(|>) = (&)-infixl 1 |>+data GramInfo = GramInfo+ { itemIndex :: !Int+ , gramCount :: !Int+ } deriving (Eq, Show) +-- | Main fuzzy string set data type.+data FuzzySet = FuzzySet+ { exactSet :: !(HashMap Text Text)+ , matchDict :: !(HashMap Text [GramInfo])+ , items :: !(HashMap Int (Vector FuzzySetItem))+ , gramSizeLower :: !Int+ -- ^ Lower bound on gram sizes to use (inclusive)+ , gramSizeUpper :: !Int+ -- ^ Upper bound on gram sizes to use (inclusive)+ , useLevenshtein :: !Bool+ -- ^ Whether or not to use the Levenshtein distance to determine the score+ } deriving (Eq, Show) --- | Dot products used to compute the cosine similarity, which is the similarity--- score assigned to entries that match the search string in the fuzzy set.+-- | An individual result when looking up a string in the set, consisting of ---matches- :: FuzzySet- -- ^ The string set- -> HashMap Text Int- -- ^ A sparse vector representation of the search string (generated by 'gramVector')- -> HashMap Int Int- -- ^ A mapping from item index to the dot product between the corresponding- -- entry of the set and the search string-matches set@FuzzySet{..} =- foldrWithKey fun mempty- where- fun gram count map =- let- insScore otherCount entry =- Just (fromMaybe 0 entry + otherCount * count)- in- gram `HashMap.lookup` matchDict- |> maybe map (foldr (\GramInfo{..} -> alter (insScore gramCount) itemIndex) map)+-- * a similarity score in the range \([0, 1]\), and+-- * the matching string.+type FuzzyMatch = (Double, Text) +matches :: FuzzySet -> HashMap Text Int -> HashMap Int Int+matches FuzzySet{..} = foldrWithKey go mempty+ where+ go gram count hashMap =+ HashMap.lookup gram matchDict+ & maybe hashMap (foldr (insert_ count) hashMap)+ insert_ count GramInfo{..} =+ insertWith (+) itemIndex (gramCount * count) --- | This function performs the actual task of querying a set for matches,--- supported by the other functions in this module.--- See [Implementation](Data-FuzzySet.html#g:8) for an explanation.----getMatches- :: FuzzySet- -- ^ The string set- -> Text- -- ^ A string to search for- -> Double- -- ^ Minimum score- -> Int- -- ^ The gram size /n/, which must be at least /2/- -> [( Double, Text )]- -- ^ A list of results (score and matched value)-getMatches set@FuzzySet{..} query minScore gramSize =- results- |> filter (\pair -> fst pair >= minScore)- |> fmap (\( score, entry ) -> ( score, exactSet |> lookupDefault "" entry ))+getMatches :: FuzzySet -> Text -> Double -> Int -> [FuzzyMatch]+getMatches FuzzySet{..} str minScore gramSize =+ results+ & filter ((>= minScore) . fst)+ & fmap (second (flip (lookupDefault mempty) exactSet)) where results =- let sorted =- matches set queryVector- |> HashMap.foldrWithKey fun []- |> sortBy (comparing (Down . fst))- in- if useLevenshtein then- sorted- |> take 50- |> fmap (\( _, entry ) -> ( distance query entry, entry ))- |> sortBy (comparing (Down . fst))- else- sorted+ let sorted =+ matches FuzzySet{..} queryVector+ & foldrWithKey go []+ & sortBy (comparing (Down . fst))+ in if useLevenshtein+ then+ sorted+ & take 50+ & fmap (\(_, entry) -> (distance str entry, entry))+ & sortBy (comparing (Down . fst))+ else sorted queryMagnitude = norm (elems queryVector)- queryVector = gramVector query gramSize- itemsVector = fromMaybe mempty (gramSize `HashMap.lookup` items)+ queryVector = gramVector str gramSize+ itemsVector = fromMaybe mempty (gramSize `lookup` items) - fun index score list =- case itemsVector !? index of- Nothing ->- list+ go index score list =+ case itemsVector !? index of+ Nothing ->+ list+ Just FuzzySetItem{..} ->+ ( fromIntegral score / (queryMagnitude * vectorMagnitude)+ , normalizedEntry+ ) : list - Just FuzzySetItem{..} ->- ( fromIntegral score / (queryMagnitude * vectorMagnitude)- , normalizedEntry- ) : list+add_ :: (MonadState FuzzySet m) => Text -> m Bool+add_ str = do+ FuzzySet{..} <- get+ if key `elem` exactSet+ then -- An entry already exists+ pure False+ else do+ traverse_ (modify . updateDict) [gramSizeLower .. gramSizeUpper]+ modify (updateExactSet key str)+ pure True+ where+ key = Text.toLower str+ updateDict size_ FuzzySet{..} =+ let+ itemVector =+ items+ & HashMap.lookup size_+ & fromMaybe Vector.empty+ grams_ =+ gramVector key size_+ insertInfo gram count =+ let info = GramInfo (Vector.length itemVector) count+ in HashMap.insertWith (<>) gram [info]+ item =+ FuzzySetItem (elems grams_ & norm) key+ in+ FuzzySet+ { items = insert size_ (itemVector `Vector.snoc` item) items+ , matchDict = foldrWithKey insertInfo matchDict grams_+ , ..+ } +addMany_ :: (MonadState FuzzySet m) => [Text] -> m [Text]+addMany_ = concat <$$> traverse addOne+ where+ addOne str = do+ p <- add_ str+ pure [str | p] -- | Generate a list of /n/-grams (character substrings) from the normalized--- input and then translate this into a dictionary with the /n/-grams as keys--- mapping to the number of occurences of the substring in the list.+-- input and then translate this into a dictionary with the /n/-grams as keys+-- mapping to the number of occurences of the substring in the list. -- -- >>> gramVector "xxxx" 2 -- fromList [("-x",1), ("xx",3), ("x-",1)]@@ -123,25 +158,15 @@ -- -- >>> Data.HashMap.Strict.lookup "nts" (gramVector "intrent'srestaurantsomeoftrent'saunt'santswantsamtorentsomepants" 3) -- Just 8----gramVector- :: Text- -- ^ An input string- -> Int- -- ^ The gram size /n/, which must be at least /2/- -> HashMap Text Int- -- ^ A sparse vector with the number of times a substring occurs in the- -- normalized input string-gramVector value size =- foldr fun HashMap.empty (grams value size)+gramVector :: Text -> Int -> HashMap Text Int+gramVector = foldr insert_ HashMap.empty <$$> grams where- fun = HashMap.alter (pure . succ . fromMaybe 0)-+ insert_ key = HashMap.insertWith (+) key 1 --- | Break apart the input string into a list of /n/-grams. The string is--- first 'Data.FuzzySet.Util.normalized' and enclosed in hyphens. We then take--- all substrings of length /n/, letting the offset range from--- \(0 \text{ to } s + 2 − n\), where /s/ is the length of the normalized input.+-- | Break apart the input string into a list of /n/-grams. The string is first+-- 'Data.FuzzySet.Util.normalized' and enclosed in hyphens. We then take all+-- substrings of length /n/, letting the offset range from \(0 \text{ to } s + 2 − n\),+-- where /s/ is the length of the normalized input. -- -- /Example:/ -- The string @"Destroido Corp."@ is first normalized to @"destroido corp"@,@@ -163,18 +188,52 @@ -- > , "orp" -- > , "rp-" -- > ]+grams :: Text -> Int -> [Text]+grams input size_+ | size_ < 2 = error "gram size_ must be at least 2"+ | otherwise = flip (substr size_) normalizedInput <$> offsets+ where+ normalizedInput = normalized input `enclosedIn` '-'+ offsets = [0 .. Text.length normalizedInput - size_]++-- | Normalize the input by ---grams- :: Text- -- ^ An input string- -> Int- -- ^ The gram size /n/, which must be at least /2/- -> [Text]- -- ^ A list of /n/-grams-grams value size- | size < 2 = error "gram size must be at least 2"- | otherwise =- (\offs -> substr size offs str) <$> offsets+-- * removing non-word characters, except for spaces and commas; and+-- * converting alphabetic characters to lowercase.+--+normalized :: Text -> Text+normalized = Text.filter word . Text.toLower where- str = normalized value `enclosedIn` '-'- offsets = [0 .. Text.length str - size]+ word char+ | isAlphaNum char = True+ | isSpace char = True+ | char == ',' = True+ | otherwise = False++-- | Return the euclidean norm, or /magnitude/, of the input list interpreted+-- as a vector.+--+-- That is,+--+-- \( \quad \sqrt{ \sum_{i=0}^n a_i^2 } \)+--+-- for the input+--+-- \( \quad \langle a_0, a_1, \dots, a_n \rangle \)+--+-- where \( a_i \) is the element at position /i/ in the input list.+norm :: [Int] -> Double+norm = sqrt . fromIntegral . sum . fmap (^ (2 :: Int))++-- | Return the normalized Levenshtein distance between the two strings.+--+-- See <https://en.wikipedia.org/wiki/Levenshtein_distance>.+distance :: Text -> Text -> Double+distance = realToFrac <$$> levenshteinNorm++updateExactSet :: Text -> Text -> FuzzySet -> FuzzySet+updateExactSet key str FuzzySet{..} =+ FuzzySet+ { exactSet = insert key str exactSet+ , ..+ }
+ src/Data/FuzzySet/Monad.hs view
@@ -0,0 +1,251 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE UndecidableInstances #-}++module Data.FuzzySet.Monad+ ( add+ , add_+ , findMin+ , values+ , addMany+ , addMany_+ , find+ , findOne+ , findOneMin+ , closestMatch+ , closestMatchMin+ , size+ , isEmpty+ , FuzzySearchT (..)+ , FuzzySearch+ , runFuzzySearchT+ , runDefaultFuzzySearchT+ , runFuzzySearch+ , runDefaultFuzzySearch+ , MonadFuzzySearch+ ) where++import Control.Monad (void)+import Control.Monad.Except (ExceptT)+import Control.Monad.Fix+import Control.Monad.Identity (Identity, runIdentity)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (ReaderT)+import Control.Monad.State (MonadState, StateT, evalStateT, gets)+import Control.Monad.Trans (MonadTrans, lift)+import Control.Monad.Trans.Cont (ContT)+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.Trans.Select (SelectT)+import Control.Monad.Writer (WriterT)+import Data.FuzzySet.Simple (FuzzySet, FuzzyMatch, emptySet)+import qualified Data.FuzzySet.Simple as Simple+import qualified Data.FuzzySet.Internal as FuzzySet+import Data.FuzzySet.Utils ((<$$$>), (<$$>))+import Data.Text (Text)++-- | FuzzySearch monad transformer+newtype FuzzySearchT m a = FuzzySearchT { getFuzzySearchT :: StateT FuzzySet m a }+ deriving+ ( Functor+ , Applicative+ , Monad+ , MonadState FuzzySet+ , MonadIO+ , MonadFix+ )++-- | Evaluate a `FuzzySearchT` computation with the given options.+runFuzzySearchT :: (Monad m)+ => FuzzySearchT m a+ -> Int+ -- ^ Lower bound on gram sizes to use (inclusive)+ -> Int+ -- ^ Upper bound on gram sizes to use (inclusive)+ -> Bool+ -- ^ Whether or not to use the Levenshtein distance to determine the score+ -> m a+ -- ^ The result of running the computation in the inner monad+runFuzzySearchT value = evalStateT ( getFuzzySearchT value ) <$$$> emptySet++-- | Evaluate a `FuzzySearchT` computation with the following defaults:+--+-- * Gram size lower: @2@+-- * Gram size upper: @3@+-- * Use Levenshtein distance: @True@+runDefaultFuzzySearchT :: (Monad m) => FuzzySearchT m a -> m a+runDefaultFuzzySearchT value = runFuzzySearchT value 2 3 True++-- | FuzzySearch monad+type FuzzySearch = FuzzySearchT Identity++-- | Evaluate a `FuzzySearch` computation with the given options.+runFuzzySearch+ :: FuzzySearch a+ -> Int+ -- ^ Lower bound on gram sizes to use (inclusive)+ -> Int+ -- ^ Upper bound on gram sizes to use (inclusive)+ -> Bool+ -- ^ Whether or not to use the Levenshtein distance to determine the score+ -> a+ -- ^ The result of running the computation+runFuzzySearch value = runIdentity <$$$> runFuzzySearchT value++-- | Evaluate a `FuzzySearch` computation with the following defaults:+--+-- * Gram size lower: @2@+-- * Gram size upper: @3@+-- * Use Levenshtein distance: @True@+runDefaultFuzzySearch :: FuzzySearch a -> a+runDefaultFuzzySearch value = runFuzzySearch value 2 3 True++class (MonadState FuzzySet m) => MonadFuzzySearch m where+ -- | Add a string to the set. A boolean is returned which is @True@ if the+ -- string was inserted, or @False@ if it already existed in the set.+ add :: Text+ -- ^ The new entry+ -> m Bool+ -- ^ A flag to indicate whether the value was added (i.e., did not+ -- already exist in the set)+ -- | Try to match a string against the entries in the set, and return a list+ -- of all results with a score greater than or equal to the specified+ -- minimum score (i.e., the first argument). The results are ordered by+ -- similarity, with the closest match first.+ findMin :: Double+ -- ^ A minimum score+ -> Text+ -- ^ The string to search for+ -> m [FuzzyMatch]+ -- ^ A list of results (score and matched value)++instance MonadTrans FuzzySearchT where+ lift = FuzzySearchT . lift++instance (Monad m) => MonadFuzzySearch (FuzzySearchT m) where+ add = FuzzySet.add_+ findMin = gets <$$> Simple.findMin++instance (MonadFuzzySearch m) => MonadFuzzySearch (StateT FuzzySet m) where+ add = lift . add+ findMin = lift <$$> findMin++instance (MonadFuzzySearch m) => MonadFuzzySearch (ExceptT e m) where+ add = lift . add+ findMin = lift <$$> findMin++instance (MonadFuzzySearch m) => MonadFuzzySearch (ReaderT r m) where+ add = lift . add+ findMin = lift <$$> findMin++instance (MonadFuzzySearch m, Monoid w) => MonadFuzzySearch (WriterT w m) where+ add = lift . add+ findMin = lift <$$> findMin++instance (MonadFuzzySearch m) => MonadFuzzySearch (MaybeT m) where+ add = lift . add+ findMin = lift <$$> findMin++instance (MonadFuzzySearch m) => MonadFuzzySearch (ContT r m) where+ add = lift . add+ findMin = lift <$$> findMin++instance (MonadFuzzySearch m, MonadState FuzzySet (SelectT s m)) => MonadFuzzySearch (SelectT s m) where+ add = lift . add+ findMin = lift <$$> findMin++-- | Add a string to the set, or do nothing if a key that matches the string+-- already exists.+--+-- This function is identical to 'add', except that the latter returns a+-- boolean to indicate whether any new value was added.+add_ :: (MonadFuzzySearch m) => Text -> m ()+add_ = void . add++-- | Add a list of strings to the set, all at once.+--+-- Unless you need to know the subset of values that were actually inserted,+-- use 'addMany_' instead.+addMany :: (MonadFuzzySearch m)+ => [Text]+ -- ^ A list of strings to add to the set+ -> m [Text]+ -- ^ A list of values that were inserted+addMany = FuzzySet.addMany_++-- | Add a list of strings to the set, all at once.+--+-- This function is identical to 'addMany', except that the latter returns a+-- list of all values that were inserted.+addMany_ :: (MonadFuzzySearch m)+ => [Text]+ -- ^ A list of strings to add to the set+ -> m ()+addMany_ = void . addMany++-- | Try to match the given string against the entries in the set, using a+-- minimum score of 0.33. Return a list of results ordered by similarity+-- score, with the closest match first. Use 'findMin' if you need to specify+-- a custom threshold value.+find :: (MonadFuzzySearch m)+ => Text+ -- ^ The string to search for+ -> m [FuzzyMatch]+ -- ^ A list of results (score and matched value)+find str = gets (Simple.find str)++-- | Try to match the given string against the entries in the set using the+-- specified minimum score and return the closest match, if one is found.+findOneMin :: (MonadFuzzySearch m)+ => Double+ -- ^ A minimum score+ -> Text+ -- ^ The string to search for+ -> m (Maybe FuzzyMatch)+ -- ^ The closest match, if one is found+findOneMin minScore str = gets (Simple.findOneMin minScore str)++-- | Try to match the given string against the entries in the set, and return+-- the closest match, if one is found. A minimum score of 0.33 is used. To+-- specify a custom threshold value, instead use 'findOneMin'.+findOne :: (MonadFuzzySearch m)+ => Text+ -- ^ The string to search for+ -> m (Maybe FuzzyMatch)+ -- ^ The closest match, if one is found+findOne str = gets (Simple.findOne str)++-- | Try to match the given string against the entries in the set using the+-- specified minimum score and return the string that most closely matches+-- the input, if a match is found.+closestMatchMin :: (MonadFuzzySearch m)+ => Double+ -- ^ A minimum score+ -> Text+ -- ^ The string to search for+ -> m (Maybe Text)+ -- ^ The string most closely matching the input, if a match is found+closestMatchMin minScore str = gets (Simple.closestMatchMin minScore str)++-- | Try to match the given string against the entries in the set, and return+-- the string that most closely matches the input, if a match is found. A+-- minimum score of 0.33 is used. To specify a custom threshold value,+-- instead use 'closestMatchMin'.+closestMatch :: (MonadFuzzySearch m)+ => Text+ -- ^ The string to search for+ -> m (Maybe Text)+ -- ^ The string most closely matching the input, if a match is found+closestMatch str = gets (Simple.closestMatch str)++-- | Return the elements of the set. No particular order is guaranteed.+values :: (MonadFuzzySearch m) => m [Text]+values = gets Simple.values++-- | Return the number of entries in the set.+size :: (MonadFuzzySearch m) => m Int+size = length <$> values++-- | Return a boolean indicating whether the set is empty.+isEmpty :: (MonadFuzzySearch m) => m Bool+isEmpty = null <$> values
+ src/Data/FuzzySet/Simple.hs view
@@ -0,0 +1,348 @@+{-# LANGUAGE RecordWildCards #-}++-- |+--+-- Module : Data.FuzzySet.Simple+-- Copyright : (c) 2017-present Heikki Johannes Hildén+-- License : BSD3+-- Maintainer : hildenjohannes@gmail.com+-- Stability : experimental+-- Portability : GHC+--+module Data.FuzzySet.Simple+ (+ -- * A note about the simple API+ --+ -- | This module exposes a /pure/, simpler API for working with fuzzy sets.+ -- If you anticipate using the fuzzy search functionality in multiple+ -- places of your application, consider using the default monadic+ -- interface in 'Data.FuzzySet'.++ -- * How to use this module+ -- $howto++ -- * Types+ FuzzySet+ , FuzzyMatch++ -- * Initialization+ , emptySet+ , defaultSet+ , fromList++ -- * Insertion+ , addToSet+ , add+ , addManyToSet+ , addMany+ , (>+<)++ -- * Lookup+ , findMin+ , findOneMin+ , closestMatchMin+ , find+ , findOne+ , closestMatch++ -- * Inspection+ , values+ , size+ , isEmpty+ ) where++import Data.FuzzySet.Internal+ ( FuzzySet(..)+ , FuzzyMatch+ , addMany_+ , add_+ , getMatches+ )++import Control.Monad.State (runState)+import Data.Text (Text)+import Data.Maybe (fromMaybe)+import Data.HashMap.Strict (elems, lookup)+import Data.FuzzySet.Utils (safeHead, (<$$>), (<$$$>))+import Data.Function ((&))+import qualified Data.Text as Text+import qualified Data.Foldable as Foldable+import Prelude hiding (lookup)++-- $howto+--+-- Make sure the @OverloadedStrings@ pragma is enabled and import the module:+--+-- > import Data.FuzzySet.Simple+--+-- After that, three steps are typically involved:+--+-- 1. Create a set using one of 'defaultSet', 'emptySet', or 'fromList'.+-- 2. To add entries, use 'add', 'addToSet', or 'addMany'.+-- 3. Query the set with 'find', 'closestMatch', 'findMin', or 'closestMatchMin'.+--+-- >>> closestMatch "percolator" (defaultSet >+< "Jurassic Park" >+< "Terminator" >+< "The Matrix")+-- Just "Terminator"+--+-- >>> find "Shaggy Jones" (defaultSet >+< "Shaggy Rogers" >+< "Fred Jones" >+< "Daphne Blake" >+< "Velma Dinkley")+-- [(0.7692307692307693,"Shaggy Rogers"),(0.5,"Fred Jones")]+--+-- There are also a few functions to inspect a set: 'size', 'isEmpty', and 'values'.+--+-- == More examples+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > import Data.FuzzySet.Simple+-- >+-- > states = [ "Alabama" , "Alaska" , "American Samoa" , "Arizona" , "Arkansas"+-- > , "California" , "Colorado" , "Connecticut" , "Delaware" , "District of Columbia"+-- > , "Florida" , "Georgia" , "Guam" , "Hawaii" , "Idaho"+-- > , "Illinois" , "Indiana" , "Iowa" , "Kansas" , "Kentucky"+-- > , "Louisiana" , "Maine" , "Maryland" , "Massachusetts" , "Michigan"+-- > , "Minnesota" , "Mississippi" , "Missouri" , "Montana" , "Nebraska"+-- > , "Nevada" , "New Hampshire" , "New Jersey" , "New Mexico" , "New York"+-- > , "North Carolina" , "North Dakota" , "Northern Marianas Islands" , "Ohio" , "Oklahoma"+-- > , "Oregon" , "Pennsylvania" , "Puerto Rico" , "Rhode Island" , "South Carolina"+-- > , "South Dakota" , "Tennessee" , "Texas" , "Utah" , "Vermont"+-- > , "Virginia" , "Virgin Islands" , "Washington" , "West Virginia" , "Wisconsin"+-- > , "Wyoming" ]+-- >+-- > statesSet = fromList states+-- >+-- > main = mapM_ print (find "Burger Islands" statesSet)+--+-- The output of this program is:+--+-- > (0.7142857142857143,"Virgin Islands")+-- > (0.5714285714285714,"Rhode Island")+-- > (0.44,"Northern Marianas Islands")+-- > (0.35714285714285715,"Maryland")+--+-- Using the definition of @statesSet@ from previous example:+--+-- > >>> find "Why-oh-me-ing" statesSet+-- > [(0.5384615384615384,"Wyoming")]+--+-- > >>> find "Connect a cat" statesSet+-- > [(0.6923076923076923,"Connecticut")]+--+-- > >>> find "Transylvania" statesSet+-- > [(0.75,"Pennsylvania"),(0.3333333333333333,"California"),(0.3333333333333333,"Arkansas"),(0.3333333333333333,"Kansas")]+--+-- > >>> find "CanOfSauce" statesSet+-- > [(0.4,"Kansas")]+--+-- > >>> find "Alaska" statesSet+-- > [(1.0,"Alaska")]+--+-- > >>> find "Alaskanbraskansas" statesSet+-- > [(0.47058823529411764,"Arkansas"),(0.35294117647058826,"Kansas"),(0.35294117647058826,"Alaska"),(0.35294117647058826,"Alabama"),(0.35294117647058826,"Nebraska")]++-- | Initialize an empty 'FuzzySet'.+emptySet+ :: Int+ -- ^ Lower bound on gram sizes to use (inclusive)+ -> Int+ -- ^ Upper bound on gram sizes to use (inclusive)+ -> Bool+ -- ^ Whether or not to use the [Levenshtein distance](https://people.cs.pitt.edu/~kirk/cs1501/Pruhs/Spring2006/assignments/editdistance/Levenshtein%20Distance.htm)+ -- to determine the score+ -> FuzzySet+ -- ^ An empty fuzzy string set+emptySet = FuzzySet mempty mempty mempty++-- | An empty 'FuzzySet' with the following defaults:+--+-- * Gram size lower: @2@+-- * Gram size upper: @3@+-- * Use Levenshtein distance: @True@+defaultSet :: FuzzySet+defaultSet = emptySet 2 3 True++-- | Try to match a string against the entries in the set, and return a list of+-- all results with a score greater than or equal to the specified minimum+-- score (i.e., the first argument). The results are ordered by similarity,+-- with the closest match first.+findMin+ :: Double+ -- ^ A minimum score+ -> Text+ -- ^ The string to search for+ -> FuzzySet+ -- ^ The fuzzy string set to compare the string against+ -> [FuzzyMatch]+ -- ^ A list of results (score and matched value)+findMin minScore str FuzzySet{..} =+ case key `lookup` exactSet of+ Just exactMatch ->+ [(1, exactMatch)]+ Nothing ->+ [gramSizeUpper, gramSizeUpper - 1 .. gramSizeLower]+ & fmap (getMatches FuzzySet{..} key minScore)+ & Foldable.find (not . null)+ & fromMaybe []+ where+ key = Text.toLower str++-- | Try to match the given string against the entries in the set using the+-- specified minimum score and return the closest match, if one is found.+findOneMin+ :: Double+ -- ^ A minimum score+ -> Text+ -- ^ The string to search for+ -> FuzzySet+ -- ^ The fuzzy string set to compare the string against+ -> Maybe FuzzyMatch+ -- ^ The closest match, if one is found+findOneMin = safeHead <$$$> findMin++-- | Try to match the given string against the entries in the set using the+-- specified minimum score and return the string that most closely matches+-- the input, if a match is found.+closestMatchMin+ :: Double+ -- ^ A minimum score+ -> Text+ -- ^ The string to search for+ -> FuzzySet+ -- ^ The fuzzy string set to compare the string against+ -> Maybe Text+ -- ^ The string most closely matching the input, if a match is found+closestMatchMin = fmap snd <$$$> findOneMin++-- | Try to match the given string against the entries in the set, using a+-- minimum score of 0.33. Return a list of results ordered by similarity+-- score, with the closest match first. Use 'findMin' if you need to specify+-- a custom threshold value.+find+ :: Text+ -- ^ The string to search for+ -> FuzzySet+ -- ^ The fuzzy string set to compare the string against+ -> [FuzzyMatch]+ -- ^ A list of results (score and matched value)+find = findMin 0.33++-- | Try to match the given string against the entries in the set, and return+-- the closest match, if one is found. A minimum score of 0.33 is used. To+-- specify a custom threshold value, instead use 'findOneMin'.+findOne+ :: Text+ -- ^ The string to search for+ -> FuzzySet+ -- ^ The fuzzy string set to compare the string against+ -> Maybe FuzzyMatch+ -- ^ The closest match, if one is found+findOne = findOneMin 0.33++-- | Try to match the given string against the entries in the set, and return+-- the string that most closely matches the input, if a match is found. A+-- minimum score of 0.33 is used. To specify a custom threshold value,+-- instead use 'closestMatchMin'.+closestMatch+ :: Text+ -- ^ The string to search for+ -> FuzzySet+ -- ^ The fuzzy string set to compare the string against+ -> Maybe Text+ -- ^ The string most closely matching the input, if a match is found+closestMatch = fmap snd <$$> findOne++-- | Add a string to the set, unless it is already present. A pair is returned+-- consisting of a boolean which denotes whether or not anything was inserted,+-- and the updated set.+addToSet+ :: Text+ -- ^ The new entry+ -> FuzzySet+ -- ^ Fuzzy string set to add the entry to+ -> (Bool, FuzzySet)+ -- ^ A flag to indicate if the value was added (i.e., did not already exist+ -- in the set), and the updated set.+addToSet = runState . add_++-- | Add a string to the set, or do nothing if a key that matches the string+-- already exists.+add+ :: Text+ -- ^ The new entry+ -> FuzzySet+ -- ^ Set to add the string to+ -> FuzzySet+ -- ^ An updated set+add = snd <$$> addToSet++-- | Infix operator to add entries to a 'FuzzySet', defined as @flip add@.+(>+<)+ :: FuzzySet+ -- ^ Set to add the string to+ -> Text+ -- ^ The new entry+ -> FuzzySet+ -- ^ An updated set+(>+<) = flip add++infixl 4 >+<++-- | Add a list of strings to the set, all at once.+--+-- Unless you need to know the subset of values that were actually inserted,+-- use 'addMany' instead.+addManyToSet+ :: [Text]+ -- ^ A list of strings to add to the set+ -> FuzzySet+ -- ^ The set to add the strings to+ -> ([Text], FuzzySet)+ -- ^ A pair where the first component is a list of all values that were+ -- inserted, and the second is the updated set.+addManyToSet = runState . addMany_++-- | Add a list of strings to the set, all at once.+--+-- This function is identical to 'addManyToSet', except that it only returns+-- the set itself. If you need to know what values were inserted, then use the+-- latter instead.+addMany+ :: [Text]+ -- ^ A list of strings to add to the set+ -> FuzzySet+ -- ^ The set to add the strings to+ -> FuzzySet+ -- ^ The updated set+addMany = snd <$$> addManyToSet++-- | Create a new set from a list of entries, using the default settings.+fromList+ :: [Text]+ -- ^ A list of strings to insert into the new set+ -> FuzzySet+ -- ^ A new fuzzy string set+fromList = (`addMany` defaultSet)++-- | Return the elements of the set. No particular order is guaranteed.+--+-- >>> values (fromList ["bass", "craze", "space", "lace", "daze", "haze", "ace", "maze"])+-- ["space","daze","bass","maze","ace","craze","lace","haze"]+values :: FuzzySet -> [Text]+values = elems . exactSet++-- | Return the number of entries in the set.+--+-- >>> size (defaultSet >+< "map" >+< "cap")+-- 2+-- >>> size (defaultSet >+< "bork" >+< "bork" >+< "bork")+-- 1+size :: FuzzySet -> Int+size = length <$> values++-- | Return a boolean indicating whether the set is empty.+--+-- >>> isEmpty (fromList [])+-- True+-- >>> isEmpty $ fromList ["Aramis", "Porthos", "Athos"]+-- False+isEmpty :: FuzzySet -> Bool+isEmpty = null <$> values
− src/Data/FuzzySet/Types.hs
@@ -1,34 +0,0 @@-module Data.FuzzySet.Types- ( FuzzySetItem(..)- , GramInfo(..)- , FuzzySet(..)- ) where--import Data.HashMap.Strict (HashMap)-import Data.Vector (Vector)-import Data.Text (Text)---data FuzzySetItem = FuzzySetItem- { vectorMagnitude :: !Double- , normalizedEntry :: !Text- } deriving (Eq, Show)---data GramInfo = GramInfo- { itemIndex :: !Int- , gramCount :: !Int- } deriving (Eq, Show)----- | Main fuzzy string set data type. Use 'Data.FuzzySet.emptySet',--- 'Data.FuzzySet.defaultSet', or 'Data.FuzzySet.fromList' to create sets.----data FuzzySet = FuzzySet- { exactSet :: !(HashMap Text Text)- , matchDict :: !(HashMap Text [GramInfo])- , items :: !(HashMap Int (Vector FuzzySetItem))- , gramSizeLower :: !Int- , gramSizeUpper :: !Int- , useLevenshtein :: !Bool- } deriving (Eq, Show)
− src/Data/FuzzySet/Util.hs
@@ -1,81 +0,0 @@-module Data.FuzzySet.Util- ( normalized- , substr- , enclosedIn- , norm- , distance- ) where--import Data.Char (isAlphaNum, isSpace)-import Data.Text (Text, cons, snoc)-import Data.Text.Metrics (levenshteinNorm)-import qualified Data.Text as Text----- | Normalize the input by------ * removing non-word characters, except for spaces and commas; and--- * converting alphabetic characters to lowercase.----normalized :: Text -> Text-{-# INLINE normalized #-}-normalized =- Text.filter word . Text.toLower- where- word char- | isAlphaNum char = True- | isSpace char = True- | char == ',' = True- | otherwise = False----- | Return /n/ characters starting from offset /m/ in the input string.----substr- :: Int- -- ^ Length of the substring- -> Int- -- ^ The character offset /m/- -> Text- -- ^ The input string- -> Text- -- ^ A substring of length /n/-{-# INLINE substr #-}-substr n m =- Text.take n . Text.drop m----- | Insert a character at the beginning and end of the given string.----enclosedIn :: Text -> Char -> Text-{-# INLINE enclosedIn #-}-enclosedIn str char =- char `cons` str `snoc` char----- | Returns the euclidean norm, or /magnitude/, of the input list interpreted--- as a vector.------ That is,------ \( \quad \sqrt{ \sum_{i=0}^n a_i^2 } \)------ for the input------ \( \quad \langle a_0, a_1, \dots, a_n \rangle \)------ where \( a_i \) is the element at position /i/ in the input list.----norm :: (Integral a, Floating b) => [a] -> b-norm =- sqrt . fromIntegral . sum . fmap (^2)----- | Return the normalized Levenshtein distance between the two strings.--- See <https://en.wikipedia.org/wiki/Levenshtein_distance>.----distance :: Text -> Text -> Double-distance s t =- fromRational (toRational dist)- where- dist = levenshteinNorm s t
+ src/Data/FuzzySet/Utils.hs view
@@ -0,0 +1,30 @@+module Data.FuzzySet.Utils+ ( (<$$>)+ , (<$$$>)+ , safeHead+ , enclosedIn+ , substr+ ) where++import Data.Text (Text, cons, snoc)+import qualified Data.Text as Text++(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)+(<$$>) = fmap . fmap++infixr 8 <$$>++(<$$$>) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))+(<$$$>) = fmap . fmap . fmap++infixr 8 <$$$>++safeHead :: [a] -> Maybe a+safeHead [] = Nothing+safeHead (h : _) = Just h++enclosedIn :: Text -> Char -> Text+enclosedIn str char = char `cons` str `snoc` char++substr :: Int -> Int -> Text -> Text+substr n m = Text.take n . Text.drop m
+ src/Main.hs view
@@ -0,0 +1,20 @@+ {-# LANGUAGE OverloadedStrings #-}+ module Main where++ import Control.Monad.Trans.Class (lift)+ import Data.Text (Text)+ import Data.FuzzySet (FuzzySearchT, add_, closestMatch, runDefaultFuzzySearchT)++ findMovie :: Text -> FuzzySearchT IO (Maybe Text)+ findMovie = closestMatch++ prog :: FuzzySearchT IO ()+ prog = do+ add_ "Jurassic Park"+ add_ "Terminator"+ add_ "The Matrix"+ result <- findMovie "The Percolator"+ lift (print result)++ main :: IO ()+ main = runDefaultFuzzySearchT prog
test/Helpers.hs view
@@ -1,25 +1,21 @@-module Helpers where+module Helpers+ ( shouldBeTrue+ , shouldBeIn+ , shouldBeCloseTo+ , shouldNotBeCloseTo+ ) where import Data.AEq-import Data.Text (Text) import Test.Hspec - shouldBeTrue :: Bool -> Expectation-shouldBeTrue = - shouldBe True-+shouldBeTrue = shouldBe True shouldBeIn :: Eq a => a -> [a] -> Expectation-shouldBeIn x xs = - shouldBeTrue (x `elem` xs)-+shouldBeIn x xs = shouldBeTrue (x `elem` xs) shouldBeCloseTo :: Double -> Double -> Expectation-shouldBeCloseTo q r = - shouldBeTrue (q ~== r)-+shouldBeCloseTo q r = shouldBeTrue (q ~== r) shouldNotBeCloseTo :: Double -> Double -> Expectation-shouldNotBeCloseTo q r = - shouldBeTrue $ not (q ~== r)+shouldNotBeCloseTo q r = shouldBeTrue $ not (q ~== r)
test/Spec.hs view
@@ -1,772 +1,899 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE UnicodeSyntax #-}--import Control.Exception (evaluate)-import Control.Monad (zipWithM_)-import Data.AEq-import Data.Function ((&))-import Data.FuzzySet hiding (fromList)-import Data.FuzzySet.Internal-import Data.FuzzySet.Types-import Data.FuzzySet.Util-import Data.HashMap.Strict (HashMap, fromList)-import Data.List (sortOn, sortBy)-import Data.Maybe (fromJust)-import Data.Maybe (fromMaybe)-import Data.Ord (compare)-import Data.Text (Text, unpack)-import Data.Vector ((!), (!?))-import Helpers-import Test.Hspec-import qualified Data.FuzzySet as FuzzySet-import qualified Data.HashMap.Strict as HashMap-import qualified Data.Text as Text---compareLists :: [( Double, Text )] -> [( Double, Text )] -> Bool-compareLists xs ys =- and (fmap f (zip xs ys))- where- f ( ( a1, b1 ), ( a2, b2 ) ) =- (b1 == b2) && (a1 ~== a2)---lookup0 :: Text -> HashMap Text Int -> Int-lookup0 =- HashMap.lookupDefault 0---checkGramsCount ∷ Text → Int → SpecWith ()-checkGramsCount input n = it message $ do- length list `shouldBe` expectedLen- shouldBeTrue $ all (==n) (Text.length <$> list)- where- list = grams input n- message = "should return a list of length "- <> show expectedLen- <> ", given the input \""- <> unpack input <> "\" and n = " <> show n- expectedLen = s - n + 3- s = Text.length input---checkMapKey ∷ HashMap Text Int → Text → Int → SpecWith ()-checkMapKey grams key value =- it message (lookup0 key grams `shouldBe` value)- where- message = "should map they key \""- <> unpack key <> "\" to "- <> show value---vectorMagnitudeOfItem ∷ FuzzySet → Int → Int → Maybe Double-vectorMagnitudeOfItem set n p =- vectorMagnitude <$> (fromJust (n `HashMap.lookup` items set) !? p)---checkMagnitude ∷ FuzzySet → Int → Int → Double → SpecWith ()-checkMagnitude set n p r =- it message $ fromMaybe 0 (vectorMagnitudeOfItem set n p) `shouldBeCloseTo` r- where- message = "should return vectorMagnitude = " <> show r- <> " for the " <> show n <> "-grams entry (index " <> show p <> ")"---checkMatchDictEntry ∷ FuzzySet → Text → [GramInfo] → SpecWith ()-checkMatchDictEntry set gram entry =- it message (sortBy srt result `shouldBe` sortBy srt entry)- where- result = fromMaybe [] (gram `HashMap.lookup` matchDict set)- message = "should return a match dict entry "- <> show entry <> " for " <> show gram- srt (GramInfo a1 b1) (GramInfo a2 b2) =- compare ( a1, b1 ) ( a2, b2 )---checkExactSet ∷ FuzzySet → [(Text, Text)] → SpecWith ()-checkExactSet set xs =- it ("should have exactSet = " <> show xs) $- exactSet set `shouldBe` fromList xs---checkGrams ∷ Text → Int → [Text] → SpecWith ()-checkGrams txt size r =- describe msg $ it ("should return " <> show r) (grams txt size `shouldBe` r)- where- msg = "grams " <> show txt <> " " <> show size---checkGramMap ∷ Text → Int → [(Text, Int)] → SpecWith ()-checkGramMap txt size r =- describe msg $ it ("should return " <> show r)- (gramVector txt size `shouldBe` fromList r)- where- msg = "gramVector " <> show txt <> " " <> show size---checkGramMapKeys ∷ Text → Int → [(Text, Int)] → SpecWith ()-checkGramMapKeys txt size keys =- describe msg $ mapM_ (uncurry $ checkMapKey grams) keys- where- msg = "gramVector " <> show txt <> " " <> show size- grams = gramVector txt size---checkMatches ∷ FuzzySet → Text → Int → [(Text, Int)] → SpecWith ()-checkMatches set txt size r =- describe msg $ it ("should return " <> show r) (sortOn fst res `shouldBe` sortOn fst r)- where- res = fmap f $ HashMap.toList $ matches set (gramVector txt size)- f (a, b) =- ( normalizedEntry ((fromJust (size `HashMap.lookup` items set)) ! a), b )- msg = "matches " <> show (exactSet set) <> " "- <> "(gramVector " <> show txt <> " " <> show size <> ")"---checkGet ∷ FuzzySet → Text → [( Double, Text )] → SpecWith ()-checkGet set val rs =- describe msg $ do- it "should return a sorted list" (sorted $ fst <$> xs)- it ("should return " <> show (length rs) <> " match(es)")- (length rs `shouldBe` length xs)- zipWithM_ ξ rs xs -- (sortOn snd rs) (sortOn snd xs)- where- xs = get set val- ξ (a, b) (a', b') = do- it ("should return a match for the string " <> show b) (b `shouldBe` b')- it ("having a score close to " <> show a) (a `shouldBeCloseTo` a')- msg = "get (" <> show (exactSet set) <> ") " <> show val---checkDistance ∷ Text → Text → Double → SpecWith ()-checkDistance s t d =- describe msg $- it ("should be approximately " <> show d)- (distance s t `shouldBeCloseTo` d)- where- msg = "edit distance between " <> show s <> " and " <> show t---sorted ∷ Ord a ⇒ [a] → Bool-sorted [ ] = True-sorted [_] = True-sorted (x:xs) = x >= head xs && sorted xs---main :: IO ()-main =- let- detectives = defaultSet `add` "Bruce Wayne" `add` "Charlie Chan" `add` "Frank Columbo" `add` "Hercule Poirot" `add` "Jane Marple" `add` "Lisbeth Salander" `add` "Nancy Drew" `add` "Nero Wolfe" `add` "Perry Mason" `add` "Philip Marlowe" `add` "Sherlock Holmes"- detectivesDict = matchDict detectives- Just map1 = HashMap.lookup "olm" detectivesDict- Just map2 = HashMap.lookup "-n" detectivesDict- Just map3 = HashMap.lookup "y " detectivesDict- Just map4 = HashMap.lookup "wa" detectivesDict- Just map5 = HashMap.lookup "ne" detectivesDict- Just map6 = HashMap.lookup "ch" detectivesDict- Just map7 = HashMap.lookup "cha" detectivesDict-- scores1 =- [ ( 0.17677669529663687, "Sherlock Holmes" )- , ( 0.10660035817780521, "Nero Wolfe" )- , ( 0.10206207261596574, "Bruce Wayne" )- , ( 0.10206207261596574, "Jane Marple" )- , ( 0.0944911182523068, "Frank Columbo" )- , ( 0.09128709291752767, "Philip Marlowe" )- ]-- scores2 =- [ ( 0.2142857142857143, "Philip Marlowe" )- , ( 0.19999999999999996, "Sherlock Holmes" )- , ( 0.19999999999999996, "Nero Wolfe" )- , ( 0.18181818181818177, "Bruce Wayne" )- , ( 0.18181818181818177, "Jane Marple" )- , ( 0.07692307692307687, "Frank Columbo" )- ]-- in- hspec $ do- describe "Large set" $ do- it "" $ do- let- names = (FuzzySet.fromList . take 132 . repeat) "John Smith"- in- length (getWithMinScore 0.72 (names `add` "Joseph Dombrowski") "Joe Dombrowski") `shouldBe` 1-- it "" $ do- let- names = (FuzzySet.fromList . take 133 . repeat) "John Smith"- in- length (getWithMinScore 0.72 (names `add` "Joseph Dombrowski") "Joe Dombrowski") `shouldBe` 1-- describe "getMatches (Detectives test data)" $ do- it "with Levenshtein" $ do- shouldBeTrue (scores2 `compareLists` getMatches detectives "Gumshoe" 0 2)-- it "without Levenshtein" $ do- let- detectives' = detectives{ useLevenshtein = False }- in- shouldBeTrue (scores1 `compareLists` getMatches detectives' "Gumshoe" 0 2)-- describe "matches" $ do- it "Watson" $ do- HashMap.fromList [(0,1),(1,1),(8,3)] `shouldBe` matches detectives (gramVector "Watson" 2)- HashMap.fromList [(8,2)] `shouldBe` matches detectives (gramVector "Watson" 3)-- it "Gumshoe" $ do- HashMap.fromList [(0,1),(2,1),(4,1),(7,1),(9,1),(10,2)] `shouldBe` matches detectives (gramVector "Gumshoe" 2)-- describe "matchDict" $ do- it "lookup \"olm\"" $ do- GramInfo 10 1 `shouldBeIn` map1-- it "lookup \"-n\"" $ do- GramInfo 6 1 `shouldBeIn` map2- GramInfo 7 1 `shouldBeIn` map2-- it "lookup \"y \"" $ do- GramInfo 6 1 `shouldBeIn` map3- GramInfo 8 1 `shouldBeIn` map3-- it "lookup \"wa\"" $ do- GramInfo 0 1 `shouldBeIn` map4-- it "lookup \"ne\"" $ do- GramInfo 0 1 `shouldBeIn` map5- GramInfo 4 1 `shouldBeIn` map5- GramInfo 7 1 `shouldBeIn` map5-- it "lookup \"ch\"" $ do- GramInfo 1 2 `shouldBeIn` map6-- it "lookup \"cha\"" $ do- GramInfo 1 2 `shouldBeIn` map7-- describe "norm" $ do- it "[2, 4, 3, 3, 3, 3, 2, 3, 2, 2, 2] should equal 9" $- 9 `shouldBeCloseTo` norm [2, 4, 3, 3, 3, 3, 2, 3, 2, 2, 2]-- describe "enclosedIn" $ do- it "\"covfefe\" 'o' should return ocovfefeo" $- "ocovfefeo" `shouldBe` ("covfefe" `enclosedIn` 'o')-- describe "grams" $ do- mapM_ (checkGramsCount "charade") [2..6]- it "should throw an error if n < 2" $- evaluate (grams "anything" 1) `shouldThrow` anyException-- checkGrams "charade" 2 ["-c", "ch", "ha", "ar", "ra", "ad", "de", "e-"]- checkGrams "charade" 2 ["-c", "ch", "ha", "ar", "ra", "ad", "de", "e-"]- checkGrams "charade" 3 ["-ch", "cha", "har", "ara", "rad", "ade", "de-"]- checkGrams "aFl1pP!.,nG FL0^ppy+" 2- [ "-a", "af", "fl", "l1", "1p", "pp", "p,", ",n", "ng", "g ", " f"- , "fl", "l0", "0p", "pp", "py", "y-" ]-- checkGramMap "xxx" 2 [("-x", 1),("xx", 2),("x-", 1)]- checkGramMap "xxx" 3 [("-xx", 1), ("xx-", 1), ("xxx", 1)]- checkGramMap "xxxxxxx" 4 [("-xxx", 1), ("xxxx", 4), ("xxx-", 1)]- checkGramMap "bananasananas" 2- [ ("-b", 1), ("ba", 1), ("an", 4), ("na", 4), ("as", 2)- , ("sa", 1), ("s-", 1) ]- checkGramMap "bananasananas" 3- [ ("-ba", 1), ("ban", 1), ("ana", 4), ("nan", 2), ("nas", 2)- , ("asa", 1), ("san", 1), ("as-", 1) ]-- checkGramMapKeys "trentsauntsrestaurant" 2- [ ("nt", 3)- , ("au", 2)- , ("ts", 2)- , ("re", 2)- , ("st", 1)- , ("en", 1) ]- checkGramMapKeys "trentsauntsrestaurant" 3- [ ("res", 1)- , ("nts", 2) ]- checkGramMapKeys "trentsantwantstorentpants" 3- [ ("pan", 1)- , ("twa", 1)- , ("ant", 3)- , ("ren", 2)- , ("ent", 2)- , ("nts", 3) ]- checkGramMapKeys "trentsantwantstorentpantstostartrestaurant" 3- [ ("ant", 4)- , ("nts", 3)- , ("sto", 2)- , ("sta", 2)- , ("ren", 2)- , ("tre", 2) ]- checkGramMapKeys "trentsantwantstorentpantstostartrestaurant" 2- [ ("an", 4)- , ("st", 4)- , ("re", 3)- , ("ts", 3)- , ("en", 2)- , ("to", 2)- , ("tr", 2)- , ("or", 1)- , ("au", 1)- , ("ur", 1) ]- checkGramMapKeys "antsintrentspantswanttrentsauntsrestaurant" 3- [ ("nts", 5)- , ("ant", 4)- , ("ent", 2) ]- checkGramMapKeys "asmartantintrentspantswantstorenttrentsauntsrestaurant" 3- [ ("nts", 5)- , ("ant", 4)- , ("ent", 3) ]- checkGramMapKeys "buffalo buffalo buffalo buffalo buffalo buffalo" 7- [ ("buffalo", 6) ]-- describe "addToSet defaultSet \"aFl1pP!.,nG FL0^ppy+\"" $- let (set, changed) = addToSet defaultSet "aFl1pP!.,nG FL0^ppy+"- in do- it "should return changed status True" $ shouldBeTrue changed- checkExactSet set [("afl1pp!.,ng fl0^ppy+", "aFl1pP!.,nG FL0^ppy+")]- checkMagnitude set 2 0 4.58257569495584- checkMagnitude set 3 0 4.0- checkMatchDictEntry set "-a" [GramInfo 0 1]- checkMatchDictEntry set "ng" [GramInfo 0 1]- checkMatchDictEntry set "fl" [GramInfo 0 2]- checkMatchDictEntry set "pp" [GramInfo 0 2]- checkMatchDictEntry set "g " [GramInfo 0 1]- checkMatchDictEntry set "xx" []-- describe "addToSet defaultSet \"Trent\"" $- let (set, changed) = addToSet defaultSet "Trent"- in do- it "should return changed status True" $ shouldBeTrue changed- checkExactSet set [("trent", "Trent")]- checkMagnitude set 2 0 2.449489742783178- checkMagnitude set 3 0 2.23606797749979- checkMatchDictEntry set "en" [GramInfo 0 1]-- describe "defaultSet `add` \"Trent\" `add` \"tent\"" $- let set = defaultSet `add` "Trent" `add` "tent"- in do- checkExactSet set [("trent", "Trent"), ("tent", "tent")]- checkMagnitude set 2 0 2.449489742783178- checkMagnitude set 2 1 2.23606797749979- checkMagnitude set 3 0 2.23606797749979- checkMagnitude set 3 1 2.0- checkMatchDictEntry set "en" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "ent" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "ten" [GramInfo 1 1]- checkMatchDictEntry set "-t" [GramInfo 0 1, GramInfo 1 1]-- describe "defaultSet `add` \"Trent\" `add` \"tent\" `add` \"restaurant\"" $- let set = defaultSet `add` "Trent" `add` "tent" `add` "restaurant"- in do- checkExactSet set- [ ("trent" , "Trent")- , ("tent" , "tent")- , ("restaurant" , "restaurant") ]- checkMagnitude set 2 0 2.449489742783178- checkMagnitude set 2 1 2.23606797749979- checkMagnitude set 2 2 3.3166247903554- checkMagnitude set 3 0 2.23606797749979- checkMagnitude set 3 1 2.0- checkMagnitude set 3 2 3.1622776601683795- checkMatchDictEntry set "tau" [GramInfo 2 1]- checkMatchDictEntry set "en" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "ten" [GramInfo 1 1]- checkMatchDictEntry set "ran" [GramInfo 2 1]- checkMatchDictEntry set "an" [GramInfo 2 1]- checkMatchDictEntry set "ant" [GramInfo 2 1]- checkMatchDictEntry set "nt-" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1]- checkMatchDictEntry set "st" [GramInfo 2 1]- checkMatchDictEntry set "es" [GramInfo 2 1]- checkMatchDictEntry set "est" [GramInfo 2 1]- checkMatchDictEntry set "re" [GramInfo 0 1, GramInfo 2 1]- checkMatchDictEntry set "-tr" [GramInfo 0 1]- checkMatchDictEntry set "res" [GramInfo 2 1]- checkMatchDictEntry set "tr" [GramInfo 0 1]- checkMatchDictEntry set "-t" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "aur" [GramInfo 2 1]- checkMatchDictEntry set "ent" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "ra" [GramInfo 2 1]- checkMatchDictEntry set "-r" [GramInfo 2 1]- checkMatchDictEntry set "ren" [GramInfo 0 1]- checkMatchDictEntry set "te" [GramInfo 1 1]- checkMatchDictEntry set "nt" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1]-- describe "defaultSet `add` \"Trent\" `add` \"tent\" `add` \"restaurant\" `add` \"xRftAntnt,!tnRant\"" $- let set = defaultSet `add` "Trent" `add` "tent" `add` "restaurant" `add` "xRftAntnt,!tnRant"- in do- checkExactSet set- [ ("trent" , "Trent")- , ("tent" , "tent")- , ("restaurant" , "restaurant")- , ("xrftantnt,!tnrant" , "xRftAntnt,!tnRant") ]- checkMagnitude set 2 0 2.449489742783178- checkMagnitude set 2 1 2.23606797749979- checkMagnitude set 2 2 3.3166247903554- checkMagnitude set 2 3 5.196152422706632- checkMagnitude set 3 0 2.23606797749979- checkMagnitude set 3 1 2.0- checkMagnitude set 3 2 3.1622776601683795- checkMagnitude set 3 3 4.242640687119285- checkMatchDictEntry set "tau" [GramInfo 2 1]- checkMatchDictEntry set "en" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "ten" [GramInfo 1 1]- checkMatchDictEntry set "ran" [GramInfo 2 1, GramInfo 3 1]- checkMatchDictEntry set "ntn" [GramInfo 3 1]- checkMatchDictEntry set "-xr" [GramInfo 3 1]- checkMatchDictEntry set "an" [GramInfo 2 1, GramInfo 3 2]- checkMatchDictEntry set "ant" [GramInfo 2 1, GramInfo 3 2]- checkMatchDictEntry set "t,t" [GramInfo 3 1]- checkMatchDictEntry set "nt-" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 1]- checkMatchDictEntry set "nt," [GramInfo 3 1]- checkMatchDictEntry set "xr" [GramInfo 3 1]- checkMatchDictEntry set "tan" [GramInfo 3 1]- checkMatchDictEntry set "st" [GramInfo 2 1]- checkMatchDictEntry set "es" [GramInfo 2 1]- checkMatchDictEntry set "fta" [GramInfo 3 1]- checkMatchDictEntry set "est" [GramInfo 2 1]- checkMatchDictEntry set "re" [GramInfo 0 1, GramInfo 2 1]- checkMatchDictEntry set "-tr" [GramInfo 0 1]- checkMatchDictEntry set "res" [GramInfo 2 1]- checkMatchDictEntry set "xrf" [GramInfo 3 1]- checkMatchDictEntry set "tr" [GramInfo 0 1]- checkMatchDictEntry set ",t" [GramInfo 3 1]- checkMatchDictEntry set "tn" [GramInfo 3 2]- checkMatchDictEntry set "-t" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "rf" [GramInfo 3 1]- checkMatchDictEntry set "aur" [GramInfo 2 1]- checkMatchDictEntry set "ent" [GramInfo 0 1, GramInfo 1 1]- checkMatchDictEntry set "ra" [GramInfo 2 1, GramInfo 3 1]- checkMatchDictEntry set "-r" [GramInfo 2 1]- checkMatchDictEntry set "-r" [GramInfo 2 1]- checkMatchDictEntry set "ren" [GramInfo 0 1]- checkMatchDictEntry set "nr" [GramInfo 3 1]- checkMatchDictEntry set "te" [GramInfo 1 1]- checkMatchDictEntry set "nt" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 3]- checkMatchDictEntry set "-x" [GramInfo 3 1]- checkMatchDictEntry set "ta" [GramInfo 2 1, GramInfo 3 1]- checkMatchDictEntry set "ft" [GramInfo 3 1]- checkMatchDictEntry set "nra" [GramInfo 3 1]- checkMatchDictEntry set ",tn" [GramInfo 3 1]- checkMatchDictEntry set "-re" [GramInfo 2 1]- checkMatchDictEntry set "ura" [GramInfo 2 1]- checkMatchDictEntry set "tnt" [GramInfo 3 1]- checkMatchDictEntry set "sta" [GramInfo 2 1]- checkMatchDictEntry set "tnr" [GramInfo 3 1]- checkMatchDictEntry set "rft" [GramInfo 3 1]- checkMatchDictEntry set "tre" [GramInfo 0 1]- checkMatchDictEntry set "ur" [GramInfo 2 1]- checkMatchDictEntry set "t," [GramInfo 3 1]- checkMatchDictEntry set "t-" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 1]- checkMatchDictEntry set "au" [GramInfo 2 1]- checkMatchDictEntry set "-te" [GramInfo 1 1]-- describe "FuzzySet 3 4 True mempty mempty mempty `add` ..." $- let set = FuzzySet mempty mempty mempty 3 4 True- `add` "Trent"- `add` "pants"- `add` "restaurant"- `add` "XrF,!TNrATaNTNTNT"- in do- checkExactSet set- [ ("trent" , "Trent")- , ("pants" , "pants")- , ("restaurant" , "restaurant")- , ("xrf,!tnratantntnt" , "XrF,!TNrATaNTNTNT") ]- checkMagnitude set 3 0 2.23606797749979- checkMagnitude set 3 1 2.23606797749979- checkMagnitude set 3 2 3.1622776601683795- checkMagnitude set 3 3 4.47213595499958- checkMagnitude set 4 0 2.0- checkMagnitude set 4 1 2.0- checkMagnitude set 4 2 3.0- checkMagnitude set 4 3 4.123105625617661- checkMatchDictEntry set "ntnt" [GramInfo 3 2]- checkMatchDictEntry set "tau" [GramInfo 2 1]- checkMatchDictEntry set "xrf" [GramInfo 3 1]- checkMatchDictEntry set "esta" [GramInfo 2 1]- checkMatchDictEntry set "-pa" [GramInfo 1 1]- checkMatchDictEntry set "ran" [GramInfo 2 1]- checkMatchDictEntry set "ntn" [GramInfo 3 2]- checkMatchDictEntry set "-xr" [GramInfo 3 1]- checkMatchDictEntry set "ants" [GramInfo 1 1]- checkMatchDictEntry set "-xrf" [GramInfo 3 1]- checkMatchDictEntry set "ant" [GramInfo 1 1, GramInfo 2 1, GramInfo 3 1]- checkMatchDictEntry set "rant" [GramInfo 2 1]- checkMatchDictEntry set "rat" [GramInfo 3 1]- checkMatchDictEntry set "antn" [GramInfo 3 1]- checkMatchDictEntry set "nt-" [GramInfo 0 1, GramInfo 2 1, GramInfo 3 1]- checkMatchDictEntry set "rent" [GramInfo 0 1]- checkMatchDictEntry set "rata" [GramInfo 3 1]- checkMatchDictEntry set "tan" [GramInfo 3 1]- checkMatchDictEntry set "tant" [GramInfo 3 1]- checkMatchDictEntry set "-tre" [GramInfo 0 1]- checkMatchDictEntry set "est" [GramInfo 2 1]- checkMatchDictEntry set "-tr" [GramInfo 0 1]-- describe "FuzzySet 2 5 True mempty mempty mempty `add` ..." $- let set = FuzzySet mempty mempty mempty 2 5 True- `add` "Trent"- `add` "restaurant"- `add` "aunt"- `add` "Smarty Pants"- `add` "XrF,!TNrATaNTNTNT"- in do- checkExactSet set- [ ("trent" , "Trent")- , ("restaurant" , "restaurant")- , ("aunt" , "aunt")- , ("smarty pants" , "Smarty Pants")- , ("xrf,!tnratantntnt" , "XrF,!TNrATaNTNTNT") ]- checkMagnitude set 2 0 2.449489742783178- checkMagnitude set 2 1 3.3166247903554- checkMagnitude set 2 2 2.23606797749979- checkMagnitude set 2 3 3.605551275463989- checkMagnitude set 2 4 5.385164807134504- checkMagnitude set 3 0 2.23606797749979- checkMagnitude set 3 1 3.1622776601683795- checkMagnitude set 3 2 2.0- checkMagnitude set 3 3 3.4641016151377544- checkMagnitude set 3 4 4.47213595499958- checkMagnitude set 4 0 2.0- checkMagnitude set 4 1 3.0- checkMagnitude set 4 2 1.7320508075688772- checkMagnitude set 4 3 3.3166247903554- checkMagnitude set 4 4 4.123105625617661- checkMagnitude set 5 0 1.7320508075688772- checkMagnitude set 5 1 2.8284271247461903- checkMagnitude set 5 2 1.4142135623730951- checkMagnitude set 5 3 3.1622776601683795- checkMagnitude set 5 4 3.7416573867739413- checkMatchDictEntry set "pant" [GramInfo 3 1]- checkMatchDictEntry set "y " [GramInfo 3 1]- checkMatchDictEntry set "-xr" [GramInfo 4 1]- checkMatchDictEntry set "rest" [GramInfo 1 1]- checkMatchDictEntry set " p" [GramInfo 3 1]- checkMatchDictEntry set "ty p" [GramInfo 3 1]- checkMatchDictEntry set "rty" [GramInfo 3 1]- checkMatchDictEntry set "-tre" [GramInfo 0 1]- checkMatchDictEntry set "-a" [GramInfo 2 1]- checkMatchDictEntry set "ty" [GramInfo 3 1]- checkMatchDictEntry set "tntnt" [GramInfo 4 1]- checkMatchDictEntry set "tr" [GramInfo 0 1]- checkMatchDictEntry set "ts" [GramInfo 3 1]- checkMatchDictEntry set "aun" [GramInfo 2 1]- checkMatchDictEntry set "tn" [GramInfo 4 3]- checkMatchDictEntry set "-t" [GramInfo 0 1]- checkMatchDictEntry set "aur" [GramInfo 1 1]- checkMatchDictEntry set "-s" [GramInfo 3 1]- checkMatchDictEntry set "-r" [GramInfo 1 1]- checkMatchDictEntry set "rty" [GramInfo 3 1]- checkMatchDictEntry set "tnra" [GramInfo 4 1]- checkMatchDictEntry set "nt" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 1, GramInfo 4 3]-- describe "values (defaultSet `add` ...)" $ do- let set = defaultSet `add` "Trent" `add` "restaurant"- `add` "aunt" `add` "Smarty Pants"- `add` "XrF,!TNrATaNTNTNT"- it "should contain the added elements" $ do- values set `shouldContain` ["Trent"]- values set `shouldContain` ["restaurant"]- values set `shouldContain` ["aunt"]- values set `shouldContain` ["Smarty Pants"]- values set `shouldContain` ["XrF,!TNrATaNTNTNT"]-- describe "size (defaultSet `add` ...)" $ do- let set = defaultSet `add` "Trent" `add` "restaurant"- `add` "aunt" `add` "Smarty Pants"- `add` "XrF,!TNrATaNTNTNT"- it "should be 5" $ size set `shouldBe` 5-- describe "isEmpty (defaultSet `add` ...)" $ do- let set = defaultSet `add` "Trent" `add` "restaurant"- `add` "aunt" `add` "Smarty Pants"- `add` "XrF,!TNrATaNTNTNT"- it "should be False" $ isEmpty set `shouldBe` False-- describe "isEmpty defaultSet" $ do- let set = defaultSet- it "should be True" $ isEmpty set `shouldBe` True-- describe "snd $ (defaultSet `add` \"again\") `addToSet` \"again\"" $ do- let set = (defaultSet `add` "again") `add` "again"- it "should return False" $- snd ((defaultSet `add` "again") `addToSet` "again") `shouldBe` False-- describe "get (defaultSet `add` \"xxx\")" $ do- let set = defaultSet `add` "xxx"- it "should return [(1, \"xxx\")]" $- get set "xxx" `shouldBe` [(1, "xxx")]-- checkMatches testset_1 "ant" 3 [("trent", 1), ("restaurant", 2), ("aunt", 1), ("smarty pants", 1)]- checkMatches testset_1 "pant" 3 [("trent", 1), ("restaurant", 2), ("aunt", 1), ("smarty pants", 2)]- checkMatches testset_1 "pants" 3 [("restaurant", 1), ("smarty pants", 4)]- checkMatches testset_1 "tre" 3 [("trent", 2)]- checkMatches testset_1 "xxx" 3 []- checkMatches testset_1 "xxx" 2 []- checkMatches testset_1 "tsap" 3 []- checkMatches testset_1 "tsap" 2 [("trent", 1), ("smarty pants", 1)]- checkMatches testset_2 "hat" 3 [("cat", 1)]- checkMatches testset_2 "anthropology" 3 [("restaurant", 1), ("smarty pants", 1)]- checkMatches testset_2 "spot" 3 []- checkMatches testset_2 "spot" 2 [("trent", 1), ("restaurant", 1), ("aunt", 1), ("smarty pants", 1), ("cat", 1)]- checkMatches testset_2 "axiom" 3 []- checkMatches testset_2 "axiom" 2 [("aunt", 1)]- checkMatches testset_3 "moped" 2 [("polymorphic", 1)]- checkMatches (defaultSet `add` "bananas") "ananas" 3 [("bananas", 7)]- checkMatches (defaultSet `add` "banana") "ananas" 3 [("banana", 5)]- checkMatches testset_6 "ia" 3 [("california", 1), ("district of columbia", 1), ("georgia", 1), ("pennsylvania", 1), ("virginia", 1), ("west virginia", 1)]- checkMatches testset_6 "was" 3 [("arkansas", 1), ("kansas", 1), ("texas", 1), ("washington", 2)]- checkMatches testset_6 "ton" 3 [("oregon", 1), ("washington", 2)]- checkMatches testset_6 "ing" 3 [("indiana", 1), ("washington", 1), ("wyoming", 2)]- checkMatches testset_6 "land" 3 [("maryland", 3), ("northern marianas islands", 2), ("rhode island", 3), ("virgin islands", 2)]- checkMatches testset_6 "sas" 3 [("arkansas", 2), ("kansas", 2), ("texas", 1)]- checkMatches testset_6 "sin" 3 [("wisconsin", 2)]- checkMatches testset_6 "new" 3 [("nebraska", 1), ("nevada", 1), ("new hampshire", 2), ("new jersey", 2), ("new mexico", 2), ("new york", 2)]-- -- Tests where useLevenshtein == False- checkGet testset_4 "flask" [(0.3651483716701107, "Alaska")]- checkGet testset_4 "lambda" [(0.40089186286863654, "Alabama")]- checkGet testset_4 "lambada" [(0.49999999999999999, "Alabama")]- checkGet testset_4 "alabama" [(1, "Alabama")]- checkGet testset_4 "al" [(0.4364357804719848, "Alaska"), (0.40824829046386296, "Alabama")]- checkGet testset_4 "albama" [(0.6172133998483676, "Alabama")]- checkGet testset_4 "Alabaska" [ (0.7216878364870323, "Alaska")- , (0.5345224838248487, "Alabama") ]- checkGet testset_5 "homeland" [(0.37499999999999994, "Maryland")]- checkGet testset_5 "connectedcut" [(0.6963106238227914, "Connecticut")]- checkGet testset_5 "oregano" [(0.4629100498862757, "Oregon")]- checkGet testset_5 "akeloxasas" [(0.4622501635210243, "Arkansas"), (0.45291081365783836, "Texas"), (0.4193139346887673, "Kansas")]- checkGet testset_5 "alaskansas" [ (0.6454972243679029, "Kansas")- , (0.6454972243679029, "Alaska")- , (0.5590169943749475, "Arkansas") ]- checkGet testset_5 "South" [ (0.5163977794943222, "South Dakota" )- , (0.47809144373375745, "South Carolina") ]- checkGet testset_5 "penicillivania" [ (0.46291004988627577, "Pennsylvania") ]- checkGet testset_5 "Michisota" [ (0.4714045207910316, "Michigan")- , (0.4444444444444444, "Minnesota") ]- checkGet testset_5 "New Mix" [ (0.47809144373375745, "New Mexico")- , (0.40089186286863654, "New York")- , (0.35856858280031806, "New Jersey") ]- checkGet testset_5 "Waioming" [ (0.5345224838248487, "Wyoming")]- checkGet testset_5 "Landland" [ (0.5103103630798287, "Maryland")- , (0.41666666666666674, "Rhode Island") ]-- checkDistance "hello" "yello" 0.8- checkDistance "fellow" "yello" 0.6666666666666667- checkDistance "fellow" "yellow" 0.8333333333333334- checkDistance "propeller" "yellow" 0.33333333333333337- checkDistance "propeller" "teller" 0.5555555555555556- checkDistance "balloon" "spoon" 0.4285714285714286- checkDistance "balloon" "electron" 0.25- checkDistance "spectrum" "electron" 0.5- checkDistance "spectrum" "techno" 0.25- checkDistance "technology" "techno" 0.6- checkDistance "technology" "logic" 0.19999999999999996- checkDistance "toxic" "logic" 0.6- checkDistance "sawa" "sawa" 1- checkDistance "fez" "baz" 0.33333333333333337- -- Just a sanity check- describe "edit distance between \"fez\" and \"baz\"" $- it ("should not be close to 0.123")- (distance "fez" "baz" `shouldNotBeCloseTo` 0.123)-- -- Tests where useLevenshtein == True- checkGet testset_6 "wyome" [ (0.5714285714285714, "Wyoming") ]- checkGet testset_6 "Louisianaland" [ ( 0.6923076923076923, "Louisiana" )- , ( 0.3846153846153846, "Maryland" )- , ( 0.3846153846153846, "Rhode Island" )- , ( 0.36, "Northern Marianas Islands" ) ]- checkGet testset_6 "ia" [ (0.5, "Iowa"), (0.4, "Idaho") ]- checkGet testset_6 "flaska" [ (0.8333333333333334, "Alaska")- , (0.5, "Nebraska")- , (0.4285714285714286, "Florida") ]- checkGet testset_7 "Alaskansas" [ (0.7, "Arkansas")- , (0.6, "Kansas")- , (0.6, "Alaska")- , (0.5, "Alabama") ]- checkGet testset_7 "Transylvania" [ (0.75, "Pennsylvania")- , (0.33333333333333337, "California") ]-----testset_1 ∷ FuzzySet-testset_1 = defaultSet `add` "Trent" `add` "restaurant"- `add` "aunt" `add` "Smarty Pants"-testset_2 ∷ FuzzySet-testset_2 = testset_1 `add` "cat"--testset_3 ∷ FuzzySet-testset_3 = testset_2 `add` "polymorphic"--testset_4 ∷ FuzzySet-testset_4 = FuzzySet mempty mempty mempty 2 3 False- `add` "Alaska" `add` "Alabama" `add` "Guam"--testset_5 ∷ FuzzySet-testset_5 = addMany (FuzzySet mempty mempty mempty 2 3 False) states--testset_6 ∷ FuzzySet-testset_6 = addMany defaultSet states--testset_7 ∷ FuzzySet-testset_7 = addMany (FuzzySet mempty mempty mempty 2 4 True) states--states ∷ [Text]-states =- [ "Alabama"- , "Alaska"- , "American Samoa"- , "Arizona"- , "Arkansas"- , "California"- , "Colorado"- , "Connecticut"- , "Delaware"- , "District of Columbia"- , "Florida"- , "Georgia"- , "Guam"- , "Hawaii"- , "Idaho"- , "Illinois"- , "Indiana"- , "Iowa"- , "Kansas"- , "Kentucky"- , "Louisiana"- , "Maine"- , "Maryland"- , "Massachusetts"- , "Michigan"- , "Minnesota"- , "Mississippi"- , "Missouri"- , "Montana"- , "Nebraska"- , "Nevada"- , "New Hampshire"- , "New Jersey"- , "New Mexico"- , "New York"- , "North Carolina"- , "North Dakota"- , "Northern Marianas Islands"- , "Ohio"- , "Oklahoma"- , "Oregon"- , "Pennsylvania"- , "Puerto Rico"- , "Rhode Island"- , "South Carolina"- , "South Dakota"- , "Tennessee"- , "Texas"- , "Utah"- , "Vermont"- , "Virginia"- , "Virgin Islands"- , "Washington"- , "West Virginia"- , "Wisconsin"- , "Wyoming" ]+{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}+{-# LANGUAGE OverloadedStrings #-}++import Control.Exception (evaluate)+import Control.Monad (zipWithM_)+import Data.AEq+import Data.FuzzySet.Simple+import Data.FuzzySet.Internal+import Data.FuzzySet.Utils (enclosedIn)+import Data.HashMap.Strict (HashMap)+import Data.List (sortBy, sortOn)+import Data.Maybe (fromJust, fromMaybe)+import Data.Text (Text, unpack)+import Data.Vector ((!), (!?))+import Helpers+import Test.Hspec+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text++compareLists :: [(Double, Text)] -> [(Double, Text)] -> Bool+compareLists xs ys = all f (zip xs ys)+ where+ f ((a1, b1), (a2, b2)) =+ (b1 == b2) && (a1 ~== a2)++lookup0 :: Text -> HashMap Text Int -> Int+lookup0 = HashMap.lookupDefault 0++checkGramsCount :: Text -> Int -> SpecWith ()+checkGramsCount input n = it message $ do+ length list `shouldBe` expectedLen+ shouldBeTrue $ all ((== n) . Text.length) list+ where+ list = grams input n+ message =+ "should return a list of length "+ <> show expectedLen+ <> ", given the input \""+ <> unpack input+ <> "\" and n = "+ <> show n+ expectedLen = s - n + 3+ s = Text.length input++checkMapKey :: HashMap Text Int -> Text -> Int -> SpecWith ()+checkMapKey grams_ key value =+ it message (lookup0 key grams_ `shouldBe` value)+ where+ message =+ "should map they key \""+ <> unpack key+ <> "\" to "+ <> show value++vectorMagnitudeOfItem :: FuzzySet -> Int -> Int -> Maybe Double+vectorMagnitudeOfItem set n p =+ vectorMagnitude <$> (fromJust (n `HashMap.lookup` items set) !? p)++checkMagnitude :: FuzzySet -> Int -> Int -> Double -> SpecWith ()+checkMagnitude set n p r =+ it message $ fromMaybe 0 (vectorMagnitudeOfItem set n p) `shouldBeCloseTo` r+ where+ message =+ "should return vectorMagnitude = "+ <> show r+ <> " for the "+ <> show n+ <> "-grams entry (index "+ <> show p+ <> ")"++checkMatchDictEntry :: FuzzySet -> Text -> [GramInfo] -> SpecWith ()+checkMatchDictEntry set gram entry =+ it message (sortBy srt result `shouldBe` sortBy srt entry)+ where+ result = fromMaybe [] (gram `HashMap.lookup` matchDict set)+ message =+ "should return a match dict entry "+ <> show entry+ <> " for "+ <> show gram+ srt (GramInfo a1 b1) (GramInfo a2 b2) =+ compare (a1, b1) (a2, b2)++checkExactSet :: FuzzySet -> [(Text, Text)] -> SpecWith ()+checkExactSet set xs =+ it ("should have exactSet = " <> show xs) $+ exactSet set `shouldBe` HashMap.fromList xs++checkGrams :: Text -> Int -> [Text] -> SpecWith ()+checkGrams txt size_ r =+ describe msg $ it ("should return " <> show r) (grams txt size_ `shouldBe` r)+ where+ msg = "grams " <> show txt <> " " <> show size_++checkGramMap :: Text -> Int -> [(Text, Int)] -> SpecWith ()+checkGramMap txt size_ r =+ describe msg $+ it+ ("should return " <> show r)+ (gramVector txt size_ `shouldBe` HashMap.fromList r)+ where+ msg = "gramVector " <> show txt <> " " <> show size_++checkGramMapKeys :: Text -> Int -> [(Text, Int)] -> SpecWith ()+checkGramMapKeys txt size_ keys =+ describe msg $ mapM_ (uncurry $ checkMapKey grams_) keys+ where+ msg = "gramVector " <> show txt <> " " <> show size_+ grams_ = gramVector txt size_++checkMatches :: FuzzySet -> Text -> Int -> [(Text, Int)] -> SpecWith ()+checkMatches set txt size_ r =+ describe msg $ it ("should return " <> show r) (sortOn fst res `shouldBe` sortOn fst r)+ where+ res = fmap f $ HashMap.toList $ matches set (gramVector txt size_)+ f (a, b) =+ (normalizedEntry (fromJust (size_ `HashMap.lookup` items set) ! a), b)+ msg =+ "matches "+ <> show (exactSet set)+ <> " "+ <> "(gramVector "+ <> show txt+ <> " "+ <> show size_+ <> ")"++checkGet :: FuzzySet -> Text -> [(Double, Text)] -> SpecWith ()+checkGet set val rs =+ describe msg $ do+ it "should return a sorted list" (sorted $ fst <$> xs)+ it+ ("should return " <> show (length rs) <> " match(es)")+ (length rs `shouldBe` length xs)+ zipWithM_ go (sortOn snd rs) (sortOn snd xs)+ where+ xs = find val set+ go (a, b) (a', b') = do+ it ("should return a match for the string " <> show b) (b `shouldBe` b')+ it ("having a score close to " <> show a) (a `shouldBeCloseTo` a')+ msg = "get (" <> show (exactSet set) <> ") " <> show val++checkDistance :: Text -> Text -> Double -> SpecWith ()+checkDistance s t d =+ describe msg $+ it+ ("should be approximately " <> show d)+ (distance s t `shouldBeCloseTo` d)+ where+ msg = "edit distance between " <> show s <> " and " <> show t++sorted :: (Ord a) => [a] -> Bool+sorted [] = True+sorted [_] = True+sorted (x : xs) = x >= head xs && sorted xs++main :: IO ()+main =+ let+ detectives = defaultSet >+< "Bruce Wayne" >+< "Charlie Chan" >+< "Frank Columbo" >+< "Hercule Poirot" >+< "Jane Marple" >+< "Lisbeth Salander" >+< "Nancy Drew" >+< "Nero Wolfe" >+< "Perry Mason" >+< "Philip Marlowe" >+< "Sherlock Holmes"+ detectivesDict = matchDict detectives+ Just map1 = HashMap.lookup "olm" detectivesDict+ Just map2 = HashMap.lookup "-n" detectivesDict+ Just map3 = HashMap.lookup "y " detectivesDict+ Just map4 = HashMap.lookup "wa" detectivesDict+ Just map5 = HashMap.lookup "ne" detectivesDict+ Just map6 = HashMap.lookup "ch" detectivesDict+ Just map7 = HashMap.lookup "cha" detectivesDict++ scores1 =+ [ (0.17677669529663687, "Sherlock Holmes")+ , (0.10660035817780521, "Nero Wolfe")+ , (0.10206207261596574, "Bruce Wayne")+ , (0.10206207261596574, "Jane Marple")+ , (0.0944911182523068, "Frank Columbo")+ , (0.09128709291752767, "Philip Marlowe")+ ]++ scores2 =+ [ (0.2142857142857143, "Philip Marlowe")+ , (0.19999999999999996, "Sherlock Holmes")+ , (0.19999999999999996, "Nero Wolfe")+ , (0.18181818181818177, "Bruce Wayne")+ , (0.18181818181818177, "Jane Marple")+ , (0.07692307692307687, "Frank Columbo")+ ]+ in+ hspec $ do+ describe "Large set" $ do+ it "" $ do+ let+ names = (fromList . replicate 132) "John Smith"+ in+ length (findMin 0.72 "Joe Dombrowski" (names >+< "Joseph Dombrowski")) `shouldBe` 1++ it "" $ do+ let+ names = (fromList . replicate 133) "John Smith"+ in+ length (findMin 0.72 "Joe Dombrowski" (names >+< "Joseph Dombrowski")) `shouldBe` 1++ describe "getMatches (Detectives test data)" $ do+ it "with Levenshtein" $ do+ shouldBeTrue (scores2 `compareLists` getMatches detectives "Gumshoe" 0 2)++ it "without Levenshtein" $ do+ let+ detectives' = detectives{useLevenshtein = False}+ in+ shouldBeTrue (scores1 `compareLists` getMatches detectives' "Gumshoe" 0 2)++ describe "matches" $ do+ it "Watson" $ do+ HashMap.fromList [(0, 1), (1, 1), (8, 3)] `shouldBe` matches detectives (gramVector "Watson" 2)+ HashMap.fromList [(8, 2)] `shouldBe` matches detectives (gramVector "Watson" 3)++ it "Gumshoe" $ do+ HashMap.fromList [(0, 1), (2, 1), (4, 1), (7, 1), (9, 1), (10, 2)] `shouldBe` matches detectives (gramVector "Gumshoe" 2)++ describe "matchDict" $ do+ it "lookup \"olm\"" $ do+ GramInfo 10 1 `shouldBeIn` map1++ it "lookup \"-n\"" $ do+ GramInfo 6 1 `shouldBeIn` map2+ GramInfo 7 1 `shouldBeIn` map2++ it "lookup \"y \"" $ do+ GramInfo 6 1 `shouldBeIn` map3+ GramInfo 8 1 `shouldBeIn` map3++ it "lookup \"wa\"" $ do+ GramInfo 0 1 `shouldBeIn` map4++ it "lookup \"ne\"" $ do+ GramInfo 0 1 `shouldBeIn` map5+ GramInfo 4 1 `shouldBeIn` map5+ GramInfo 7 1 `shouldBeIn` map5++ it "lookup \"ch\"" $ do+ GramInfo 1 2 `shouldBeIn` map6++ it "lookup \"cha\"" $ do+ GramInfo 1 2 `shouldBeIn` map7++ describe "norm" $ do+ it "[2, 4, 3, 3, 3, 3, 2, 3, 2, 2, 2] should equal 9" $+ 9 `shouldBeCloseTo` norm [2, 4, 3, 3, 3, 3, 2, 3, 2, 2, 2]++ describe "enclosedIn" $ do+ it "\"covfefe\" 'o' should return ocovfefeo" $+ "ocovfefeo" `shouldBe` ("covfefe" `enclosedIn` 'o')++ describe "grams" $ do+ mapM_ (checkGramsCount "charade") [2 .. 6]+ it "should throw an error if n < 2" $+ evaluate (grams "anything" 1) `shouldThrow` anyException++ checkGrams "charade" 2 ["-c", "ch", "ha", "ar", "ra", "ad", "de", "e-"]+ checkGrams "charade" 2 ["-c", "ch", "ha", "ar", "ra", "ad", "de", "e-"]+ checkGrams "charade" 3 ["-ch", "cha", "har", "ara", "rad", "ade", "de-"]+ checkGrams+ "aFl1pP!.,nG FL0^ppy+"+ 2+ [ "-a"+ , "af"+ , "fl"+ , "l1"+ , "1p"+ , "pp"+ , "p,"+ , ",n"+ , "ng"+ , "g "+ , " f"+ , "fl"+ , "l0"+ , "0p"+ , "pp"+ , "py"+ , "y-"+ ]++ checkGramMap "xxx" 2 [("-x", 1), ("xx", 2), ("x-", 1)]+ checkGramMap "xxx" 3 [("-xx", 1), ("xx-", 1), ("xxx", 1)]+ checkGramMap "xxxxxxx" 4 [("-xxx", 1), ("xxxx", 4), ("xxx-", 1)]+ checkGramMap+ "bananasananas"+ 2+ [ ("-b", 1)+ , ("ba", 1)+ , ("an", 4)+ , ("na", 4)+ , ("as", 2)+ , ("sa", 1)+ , ("s-", 1)+ ]+ checkGramMap+ "bananasananas"+ 3+ [ ("-ba", 1)+ , ("ban", 1)+ , ("ana", 4)+ , ("nan", 2)+ , ("nas", 2)+ , ("asa", 1)+ , ("san", 1)+ , ("as-", 1)+ ]++ checkGramMapKeys+ "trentsauntsrestaurant"+ 2+ [ ("nt", 3)+ , ("au", 2)+ , ("ts", 2)+ , ("re", 2)+ , ("st", 1)+ , ("en", 1)+ ]+ checkGramMapKeys+ "trentsauntsrestaurant"+ 3+ [ ("res", 1)+ , ("nts", 2)+ ]+ checkGramMapKeys+ "trentsantwantstorentpants"+ 3+ [ ("pan", 1)+ , ("twa", 1)+ , ("ant", 3)+ , ("ren", 2)+ , ("ent", 2)+ , ("nts", 3)+ ]+ checkGramMapKeys+ "trentsantwantstorentpantstostartrestaurant"+ 3+ [ ("ant", 4)+ , ("nts", 3)+ , ("sto", 2)+ , ("sta", 2)+ , ("ren", 2)+ , ("tre", 2)+ ]+ checkGramMapKeys+ "trentsantwantstorentpantstostartrestaurant"+ 2+ [ ("an", 4)+ , ("st", 4)+ , ("re", 3)+ , ("ts", 3)+ , ("en", 2)+ , ("to", 2)+ , ("tr", 2)+ , ("or", 1)+ , ("au", 1)+ , ("ur", 1)+ ]+ checkGramMapKeys+ "antsintrentspantswanttrentsauntsrestaurant"+ 3+ [ ("nts", 5)+ , ("ant", 4)+ , ("ent", 2)+ ]+ checkGramMapKeys+ "asmartantintrentspantswantstorenttrentsauntsrestaurant"+ 3+ [ ("nts", 5)+ , ("ant", 4)+ , ("ent", 3)+ ]+ checkGramMapKeys+ "buffalo buffalo buffalo buffalo buffalo buffalo"+ 7+ [("buffalo", 6)]++ describe "addToSet defaultSet \"aFl1pP!.,nG FL0^ppy+\"" $+ let (changed, set) = addToSet "aFl1pP!.,nG FL0^ppy+" defaultSet+ in do+ it "should return changed status True" $ shouldBeTrue changed+ checkExactSet set [("afl1pp!.,ng fl0^ppy+", "aFl1pP!.,nG FL0^ppy+")]+ checkMagnitude set 2 0 4.58257569495584+ checkMagnitude set 3 0 4.0+ checkMatchDictEntry set "-a" [GramInfo 0 1]+ checkMatchDictEntry set "ng" [GramInfo 0 1]+ checkMatchDictEntry set "fl" [GramInfo 0 2]+ checkMatchDictEntry set "pp" [GramInfo 0 2]+ checkMatchDictEntry set "g " [GramInfo 0 1]+ checkMatchDictEntry set "xx" []++ describe "addToSet defaultSet \"Trent\"" $+ let (changed, set) = addToSet "Trent" defaultSet+ in do+ it "should return changed status True" $ shouldBeTrue changed+ checkExactSet set [("trent", "Trent")]+ checkMagnitude set 2 0 2.449489742783178+ checkMagnitude set 3 0 2.23606797749979+ checkMatchDictEntry set "en" [GramInfo 0 1]++ describe "defaultSet `add` \"Trent\" `add` \"tent\"" $+ let set = defaultSet >+< "Trent" >+< "tent"+ in do+ checkExactSet set [("trent", "Trent"), ("tent", "tent")]+ checkMagnitude set 2 0 2.449489742783178+ checkMagnitude set 2 1 2.23606797749979+ checkMagnitude set 3 0 2.23606797749979+ checkMagnitude set 3 1 2.0+ checkMatchDictEntry set "en" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "ent" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "ten" [GramInfo 1 1]+ checkMatchDictEntry set "-t" [GramInfo 0 1, GramInfo 1 1]++ describe "defaultSet `add` \"Trent\" `add` \"tent\" `add` \"restaurant\"" $+ let set = defaultSet >+< "Trent" >+< "tent" >+< "restaurant"+ in do+ checkExactSet+ set+ [ ("trent", "Trent")+ , ("tent", "tent")+ , ("restaurant", "restaurant")+ ]+ checkMagnitude set 2 0 2.449489742783178+ checkMagnitude set 2 1 2.23606797749979+ checkMagnitude set 2 2 3.3166247903554+ checkMagnitude set 3 0 2.23606797749979+ checkMagnitude set 3 1 2.0+ checkMagnitude set 3 2 3.1622776601683795+ checkMatchDictEntry set "tau" [GramInfo 2 1]+ checkMatchDictEntry set "en" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "ten" [GramInfo 1 1]+ checkMatchDictEntry set "ran" [GramInfo 2 1]+ checkMatchDictEntry set "an" [GramInfo 2 1]+ checkMatchDictEntry set "ant" [GramInfo 2 1]+ checkMatchDictEntry set "nt-" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1]+ checkMatchDictEntry set "st" [GramInfo 2 1]+ checkMatchDictEntry set "es" [GramInfo 2 1]+ checkMatchDictEntry set "est" [GramInfo 2 1]+ checkMatchDictEntry set "re" [GramInfo 0 1, GramInfo 2 1]+ checkMatchDictEntry set "-tr" [GramInfo 0 1]+ checkMatchDictEntry set "res" [GramInfo 2 1]+ checkMatchDictEntry set "tr" [GramInfo 0 1]+ checkMatchDictEntry set "-t" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "aur" [GramInfo 2 1]+ checkMatchDictEntry set "ent" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "ra" [GramInfo 2 1]+ checkMatchDictEntry set "-r" [GramInfo 2 1]+ checkMatchDictEntry set "ren" [GramInfo 0 1]+ checkMatchDictEntry set "te" [GramInfo 1 1]+ checkMatchDictEntry set "nt" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1]++ describe "defaultSet `add` \"Trent\" `add` \"tent\" `add` \"restaurant\" `add` \"xRftAntnt,!tnRant\"" $+ let set = defaultSet >+< "Trent" >+< "tent" >+< "restaurant" >+< "xRftAntnt,!tnRant"+ in do+ checkExactSet+ set+ [ ("trent", "Trent")+ , ("tent", "tent")+ , ("restaurant", "restaurant")+ , ("xrftantnt,!tnrant", "xRftAntnt,!tnRant")+ ]+ checkMagnitude set 2 0 2.449489742783178+ checkMagnitude set 2 1 2.23606797749979+ checkMagnitude set 2 2 3.3166247903554+ checkMagnitude set 2 3 5.196152422706632+ checkMagnitude set 3 0 2.23606797749979+ checkMagnitude set 3 1 2.0+ checkMagnitude set 3 2 3.1622776601683795+ checkMagnitude set 3 3 4.242640687119285+ checkMatchDictEntry set "tau" [GramInfo 2 1]+ checkMatchDictEntry set "en" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "ten" [GramInfo 1 1]+ checkMatchDictEntry set "ran" [GramInfo 2 1, GramInfo 3 1]+ checkMatchDictEntry set "ntn" [GramInfo 3 1]+ checkMatchDictEntry set "-xr" [GramInfo 3 1]+ checkMatchDictEntry set "an" [GramInfo 2 1, GramInfo 3 2]+ checkMatchDictEntry set "ant" [GramInfo 2 1, GramInfo 3 2]+ checkMatchDictEntry set "t,t" [GramInfo 3 1]+ checkMatchDictEntry set "nt-" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 1]+ checkMatchDictEntry set "nt," [GramInfo 3 1]+ checkMatchDictEntry set "xr" [GramInfo 3 1]+ checkMatchDictEntry set "tan" [GramInfo 3 1]+ checkMatchDictEntry set "st" [GramInfo 2 1]+ checkMatchDictEntry set "es" [GramInfo 2 1]+ checkMatchDictEntry set "fta" [GramInfo 3 1]+ checkMatchDictEntry set "est" [GramInfo 2 1]+ checkMatchDictEntry set "re" [GramInfo 0 1, GramInfo 2 1]+ checkMatchDictEntry set "-tr" [GramInfo 0 1]+ checkMatchDictEntry set "res" [GramInfo 2 1]+ checkMatchDictEntry set "xrf" [GramInfo 3 1]+ checkMatchDictEntry set "tr" [GramInfo 0 1]+ checkMatchDictEntry set ",t" [GramInfo 3 1]+ checkMatchDictEntry set "tn" [GramInfo 3 2]+ checkMatchDictEntry set "-t" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "rf" [GramInfo 3 1]+ checkMatchDictEntry set "aur" [GramInfo 2 1]+ checkMatchDictEntry set "ent" [GramInfo 0 1, GramInfo 1 1]+ checkMatchDictEntry set "ra" [GramInfo 2 1, GramInfo 3 1]+ checkMatchDictEntry set "-r" [GramInfo 2 1]+ checkMatchDictEntry set "-r" [GramInfo 2 1]+ checkMatchDictEntry set "ren" [GramInfo 0 1]+ checkMatchDictEntry set "nr" [GramInfo 3 1]+ checkMatchDictEntry set "te" [GramInfo 1 1]+ checkMatchDictEntry set "nt" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 3]+ checkMatchDictEntry set "-x" [GramInfo 3 1]+ checkMatchDictEntry set "ta" [GramInfo 2 1, GramInfo 3 1]+ checkMatchDictEntry set "ft" [GramInfo 3 1]+ checkMatchDictEntry set "nra" [GramInfo 3 1]+ checkMatchDictEntry set ",tn" [GramInfo 3 1]+ checkMatchDictEntry set "-re" [GramInfo 2 1]+ checkMatchDictEntry set "ura" [GramInfo 2 1]+ checkMatchDictEntry set "tnt" [GramInfo 3 1]+ checkMatchDictEntry set "sta" [GramInfo 2 1]+ checkMatchDictEntry set "tnr" [GramInfo 3 1]+ checkMatchDictEntry set "rft" [GramInfo 3 1]+ checkMatchDictEntry set "tre" [GramInfo 0 1]+ checkMatchDictEntry set "ur" [GramInfo 2 1]+ checkMatchDictEntry set "t," [GramInfo 3 1]+ checkMatchDictEntry set "t-" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 1]+ checkMatchDictEntry set "au" [GramInfo 2 1]+ checkMatchDictEntry set "-te" [GramInfo 1 1]++ describe "FuzzySet 3 4 True mempty mempty mempty `add` ..." $+ let set =+ FuzzySet mempty mempty mempty 3 4 True+ >+< "Trent"+ >+< "pants"+ >+< "restaurant"+ >+< "XrF,!TNrATaNTNTNT"+ in do+ checkExactSet+ set+ [ ("trent", "Trent")+ , ("pants", "pants")+ , ("restaurant", "restaurant")+ , ("xrf,!tnratantntnt", "XrF,!TNrATaNTNTNT")+ ]+ checkMagnitude set 3 0 2.23606797749979+ checkMagnitude set 3 1 2.23606797749979+ checkMagnitude set 3 2 3.1622776601683795+ checkMagnitude set 3 3 4.47213595499958+ checkMagnitude set 4 0 2.0+ checkMagnitude set 4 1 2.0+ checkMagnitude set 4 2 3.0+ checkMagnitude set 4 3 4.123105625617661+ checkMatchDictEntry set "ntnt" [GramInfo 3 2]+ checkMatchDictEntry set "tau" [GramInfo 2 1]+ checkMatchDictEntry set "xrf" [GramInfo 3 1]+ checkMatchDictEntry set "esta" [GramInfo 2 1]+ checkMatchDictEntry set "-pa" [GramInfo 1 1]+ checkMatchDictEntry set "ran" [GramInfo 2 1]+ checkMatchDictEntry set "ntn" [GramInfo 3 2]+ checkMatchDictEntry set "-xr" [GramInfo 3 1]+ checkMatchDictEntry set "ants" [GramInfo 1 1]+ checkMatchDictEntry set "-xrf" [GramInfo 3 1]+ checkMatchDictEntry set "ant" [GramInfo 1 1, GramInfo 2 1, GramInfo 3 1]+ checkMatchDictEntry set "rant" [GramInfo 2 1]+ checkMatchDictEntry set "rat" [GramInfo 3 1]+ checkMatchDictEntry set "antn" [GramInfo 3 1]+ checkMatchDictEntry set "nt-" [GramInfo 0 1, GramInfo 2 1, GramInfo 3 1]+ checkMatchDictEntry set "rent" [GramInfo 0 1]+ checkMatchDictEntry set "rata" [GramInfo 3 1]+ checkMatchDictEntry set "tan" [GramInfo 3 1]+ checkMatchDictEntry set "tant" [GramInfo 3 1]+ checkMatchDictEntry set "-tre" [GramInfo 0 1]+ checkMatchDictEntry set "est" [GramInfo 2 1]+ checkMatchDictEntry set "-tr" [GramInfo 0 1]++ describe "FuzzySet 2 5 True mempty mempty mempty >+< ..." $+ let set =+ FuzzySet mempty mempty mempty 2 5 True+ >+< "Trent"+ >+< "restaurant"+ >+< "aunt"+ >+< "Smarty Pants"+ >+< "XrF,!TNrATaNTNTNT"+ in do+ checkExactSet+ set+ [ ("trent", "Trent")+ , ("restaurant", "restaurant")+ , ("aunt", "aunt")+ , ("smarty pants", "Smarty Pants")+ , ("xrf,!tnratantntnt", "XrF,!TNrATaNTNTNT")+ ]+ checkMagnitude set 2 0 2.449489742783178+ checkMagnitude set 2 1 3.3166247903554+ checkMagnitude set 2 2 2.23606797749979+ checkMagnitude set 2 3 3.605551275463989+ checkMagnitude set 2 4 5.385164807134504+ checkMagnitude set 3 0 2.23606797749979+ checkMagnitude set 3 1 3.1622776601683795+ checkMagnitude set 3 2 2.0+ checkMagnitude set 3 3 3.4641016151377544+ checkMagnitude set 3 4 4.47213595499958+ checkMagnitude set 4 0 2.0+ checkMagnitude set 4 1 3.0+ checkMagnitude set 4 2 1.7320508075688772+ checkMagnitude set 4 3 3.3166247903554+ checkMagnitude set 4 4 4.123105625617661+ checkMagnitude set 5 0 1.7320508075688772+ checkMagnitude set 5 1 2.8284271247461903+ checkMagnitude set 5 2 1.4142135623730951+ checkMagnitude set 5 3 3.1622776601683795+ checkMagnitude set 5 4 3.7416573867739413+ checkMatchDictEntry set "pant" [GramInfo 3 1]+ checkMatchDictEntry set "y " [GramInfo 3 1]+ checkMatchDictEntry set "-xr" [GramInfo 4 1]+ checkMatchDictEntry set "rest" [GramInfo 1 1]+ checkMatchDictEntry set " p" [GramInfo 3 1]+ checkMatchDictEntry set "ty p" [GramInfo 3 1]+ checkMatchDictEntry set "rty" [GramInfo 3 1]+ checkMatchDictEntry set "-tre" [GramInfo 0 1]+ checkMatchDictEntry set "-a" [GramInfo 2 1]+ checkMatchDictEntry set "ty" [GramInfo 3 1]+ checkMatchDictEntry set "tntnt" [GramInfo 4 1]+ checkMatchDictEntry set "tr" [GramInfo 0 1]+ checkMatchDictEntry set "ts" [GramInfo 3 1]+ checkMatchDictEntry set "aun" [GramInfo 2 1]+ checkMatchDictEntry set "tn" [GramInfo 4 3]+ checkMatchDictEntry set "-t" [GramInfo 0 1]+ checkMatchDictEntry set "aur" [GramInfo 1 1]+ checkMatchDictEntry set "-s" [GramInfo 3 1]+ checkMatchDictEntry set "-r" [GramInfo 1 1]+ checkMatchDictEntry set "rty" [GramInfo 3 1]+ checkMatchDictEntry set "tnra" [GramInfo 4 1]+ checkMatchDictEntry set "nt" [GramInfo 0 1, GramInfo 1 1, GramInfo 2 1, GramInfo 3 1, GramInfo 4 3]++ describe "values (defaultSet `add` ...)" $ do+ let set =+ defaultSet+ >+< "Trent"+ >+< "restaurant"+ >+< "aunt"+ >+< "Smarty Pants"+ >+< "XrF,!TNrATaNTNTNT"+ it "should contain the added elements" $ do+ values set `shouldContain` ["Trent"]+ values set `shouldContain` ["restaurant"]+ values set `shouldContain` ["aunt"]+ values set `shouldContain` ["Smarty Pants"]+ values set `shouldContain` ["XrF,!TNrATaNTNTNT"]++ describe "size (defaultSet >+< ...)" $ do+ let set =+ defaultSet+ >+< "Trent"+ >+< "restaurant"+ >+< "aunt"+ >+< "Smarty Pants"+ >+< "XrF,!TNrATaNTNTNT"+ it "should be 5" $ size set `shouldBe` 5++ describe "isEmpty (defaultSet `add` ...)" $ do+ let set =+ defaultSet+ >+< "Trent"+ >+< "restaurant"+ >+< "aunt"+ >+< "Smarty Pants"+ >+< "XrF,!TNrATaNTNTNT"+ it "should be False" $ isEmpty set `shouldBe` False++ describe "isEmpty defaultSet" $ do+ let set = defaultSet+ it "should be True" $ isEmpty set `shouldBe` True++ describe "snd $ (defaultSet `add` \"again\") `addToSet` \"again\"" $ do+ it "should return False" $+ fst (addToSet "again" (defaultSet >+< "again")) `shouldBe` False++ describe "get (defaultSet `add` \"xxx\")" $ do+ let set = defaultSet >+< "xxx"+ it "should return [(1, \"xxx\")]" $+ find "xxx" set `shouldBe` [(1, "xxx")]++ checkMatches testset_1 "ant" 3 [("trent", 1), ("restaurant", 2), ("aunt", 1), ("smarty pants", 1)]+ checkMatches testset_1 "pant" 3 [("trent", 1), ("restaurant", 2), ("aunt", 1), ("smarty pants", 2)]+ checkMatches testset_1 "pants" 3 [("restaurant", 1), ("smarty pants", 4)]+ checkMatches testset_1 "tre" 3 [("trent", 2)]+ checkMatches testset_1 "xxx" 3 []+ checkMatches testset_1 "xxx" 2 []+ checkMatches testset_1 "tsap" 3 []+ checkMatches testset_1 "tsap" 2 [("trent", 1), ("smarty pants", 1)]+ checkMatches testset_2 "hat" 3 [("cat", 1)]+ checkMatches testset_2 "anthropology" 3 [("restaurant", 1), ("smarty pants", 1)]+ checkMatches testset_2 "spot" 3 []+ checkMatches testset_2 "spot" 2 [("trent", 1), ("restaurant", 1), ("aunt", 1), ("smarty pants", 1), ("cat", 1)]+ checkMatches testset_2 "axiom" 3 []+ checkMatches testset_2 "axiom" 2 [("aunt", 1)]+ checkMatches testset_3 "moped" 2 [("polymorphic", 1)]+ checkMatches (defaultSet >+< "bananas") "ananas" 3 [("bananas", 7)]+ checkMatches (defaultSet >+< "banana") "ananas" 3 [("banana", 5)]+ checkMatches testset_6 "ia" 3 [("california", 1), ("district of columbia", 1), ("georgia", 1), ("pennsylvania", 1), ("virginia", 1), ("west virginia", 1)]+ checkMatches testset_6 "was" 3 [("arkansas", 1), ("kansas", 1), ("texas", 1), ("washington", 2)]+ checkMatches testset_6 "ton" 3 [("oregon", 1), ("washington", 2)]+ checkMatches testset_6 "ing" 3 [("indiana", 1), ("washington", 1), ("wyoming", 2)]+ checkMatches testset_6 "land" 3 [("maryland", 3), ("northern marianas islands", 2), ("rhode island", 3), ("virgin islands", 2)]+ checkMatches testset_6 "sas" 3 [("arkansas", 2), ("kansas", 2), ("texas", 1)]+ checkMatches testset_6 "sin" 3 [("wisconsin", 2)]+ checkMatches testset_6 "new" 3 [("nebraska", 1), ("nevada", 1), ("new hampshire", 2), ("new jersey", 2), ("new mexico", 2), ("new york", 2)]++ -- Tests where useLevenshtein == False+ checkGet testset_4 "flask" [(0.3651483716701107, "Alaska")]+ checkGet testset_4 "lambda" [(0.40089186286863654, "Alabama")]+ checkGet testset_4 "lambada" [(0.49999999999999999, "Alabama")]+ checkGet testset_4 "alabama" [(1, "Alabama")]+ checkGet testset_4 "al" [(0.4364357804719848, "Alaska"), (0.40824829046386296, "Alabama")]+ checkGet testset_4 "albama" [(0.6172133998483676, "Alabama")]+ checkGet+ testset_4+ "Alabaska"+ [ (0.7216878364870323, "Alaska")+ , (0.5345224838248487, "Alabama")+ ]+ checkGet testset_5 "homeland" [(0.37499999999999994, "Maryland")]+ checkGet testset_5 "connectedcut" [(0.6963106238227914, "Connecticut")]+ checkGet testset_5 "oregano" [(0.4629100498862757, "Oregon")]+ checkGet testset_5 "akeloxasas" [(0.4622501635210243, "Arkansas"), (0.45291081365783836, "Texas"), (0.4193139346887673, "Kansas")]+ checkGet+ testset_5+ "alaskansas"+ [ (0.6454972243679029, "Kansas")+ , (0.6454972243679029, "Alaska")+ , (0.5590169943749475, "Arkansas")+ ]+ checkGet+ testset_5+ "South"+ [ (0.5163977794943222, "South Dakota")+ , (0.47809144373375745, "South Carolina")+ ]+ checkGet testset_5 "penicillivania" [(0.46291004988627577, "Pennsylvania")]+ checkGet+ testset_5+ "Michisota"+ [ (0.4714045207910316, "Michigan")+ , (0.4444444444444444, "Minnesota")+ ]+ checkGet+ testset_5+ "New Mix"+ [ (0.47809144373375745, "New Mexico")+ , (0.40089186286863654, "New York")+ , (0.35856858280031806, "New Jersey")+ ]+ checkGet testset_5 "Waioming" [(0.5345224838248487, "Wyoming")]+ checkGet+ testset_5+ "Landland"+ [ (0.5103103630798287, "Maryland")+ , (0.41666666666666674, "Rhode Island")+ ]++ checkDistance "hello" "yello" 0.8+ checkDistance "fellow" "yello" 0.6666666666666667+ checkDistance "fellow" "yellow" 0.8333333333333334+ checkDistance "propeller" "yellow" 0.33333333333333337+ checkDistance "propeller" "teller" 0.5555555555555556+ checkDistance "balloon" "spoon" 0.4285714285714286+ checkDistance "balloon" "electron" 0.25+ checkDistance "spectrum" "electron" 0.5+ checkDistance "spectrum" "techno" 0.25+ checkDistance "technology" "techno" 0.6+ checkDistance "technology" "logic" 0.19999999999999996+ checkDistance "toxic" "logic" 0.6+ checkDistance "sawa" "sawa" 1+ checkDistance "fez" "baz" 0.33333333333333337+ -- Just a sanity check+ describe "edit distance between \"fez\" and \"baz\"" $+ it+ "should not be close to 0.123"+ (distance "fez" "baz" `shouldNotBeCloseTo` 0.123)++ -- Tests where useLevenshtein == True+ checkGet testset_6 "wyome" [(0.5714285714285714, "Wyoming")]+ checkGet+ testset_6+ "Louisianaland"+ [ (0.6923076923076923, "Louisiana")+ , (0.3846153846153846, "Maryland")+ , (0.3846153846153846, "Rhode Island")+ , (0.36, "Northern Marianas Islands")+ ]+ checkGet testset_6 "ia" [(0.5, "Iowa"), (0.4, "Idaho")]+ checkGet+ testset_6+ "flaska"+ [ (0.8333333333333334, "Alaska")+ , (0.5, "Nebraska")+ , (0.4285714285714286, "Florida")+ ]+ checkGet+ testset_7+ "Alaskansas"+ [ (0.7, "Arkansas")+ , (0.6, "Kansas")+ , (0.6, "Alaska")+ , (0.5, "Alabama")+ ]+ checkGet+ testset_7+ "Transylvania"+ [ (0.75, "Pennsylvania")+ , (0.33333333333333337, "California")+ ]++testset_1 :: FuzzySet+testset_1 =+ defaultSet+ >+< "Trent"+ >+< "restaurant"+ >+< "aunt"+ >+< "Smarty Pants"++testset_2 :: FuzzySet+testset_2 = testset_1 >+< "cat"++testset_3 :: FuzzySet+testset_3 = testset_2 >+< "polymorphic"++testset_4 :: FuzzySet+testset_4 =+ FuzzySet mempty mempty mempty 2 3 False+ >+< "Alaska"+ >+< "Alabama"+ >+< "Guam"++testset_5 :: FuzzySet+testset_5 = addMany states (FuzzySet mempty mempty mempty 2 3 False)++testset_6 :: FuzzySet+testset_6 = addMany states defaultSet++testset_7 :: FuzzySet+testset_7 = addMany states (FuzzySet mempty mempty mempty 2 4 True)++states :: [Text]+states =+ [ "Alabama"+ , "Alaska"+ , "American Samoa"+ , "Arizona"+ , "Arkansas"+ , "California"+ , "Colorado"+ , "Connecticut"+ , "Delaware"+ , "District of Columbia"+ , "Florida"+ , "Georgia"+ , "Guam"+ , "Hawaii"+ , "Idaho"+ , "Illinois"+ , "Indiana"+ , "Iowa"+ , "Kansas"+ , "Kentucky"+ , "Louisiana"+ , "Maine"+ , "Maryland"+ , "Massachusetts"+ , "Michigan"+ , "Minnesota"+ , "Mississippi"+ , "Missouri"+ , "Montana"+ , "Nebraska"+ , "Nevada"+ , "New Hampshire"+ , "New Jersey"+ , "New Mexico"+ , "New York"+ , "North Carolina"+ , "North Dakota"+ , "Northern Marianas Islands"+ , "Ohio"+ , "Oklahoma"+ , "Oregon"+ , "Pennsylvania"+ , "Puerto Rico"+ , "Rhode Island"+ , "South Carolina"+ , "South Dakota"+ , "Tennessee"+ , "Texas"+ , "Utah"+ , "Vermont"+ , "Virginia"+ , "Virgin Islands"+ , "Washington"+ , "West Virginia"+ , "Wisconsin"+ , "Wyoming"+ ]