fuzzyset (empty) → 0.1.0.0
raw patch · 11 files changed
+1352/−0 lines, 11 filesdep +basedep +base-unicode-symbolsdep +data-defaultsetup-changed
Dependencies added: base, base-unicode-symbols, data-default, fuzzyset, hspec, ieee754, lens, text, text-metrics, unordered-containers, vector
Files
- LICENSE +30/−0
- README.md +83/−0
- Setup.hs +2/−0
- app/Main.hs +6/−0
- fuzzyset.cabal +58/−0
- src/Data/FuzzySet.hs +262/−0
- src/Data/FuzzySet/Internal.hs +89/−0
- src/Data/FuzzySet/Lens.hs +32/−0
- src/Data/FuzzySet/Types.hs +56/−0
- src/Data/FuzzySet/Util.hs +80/−0
- test/Spec.hs +654/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Johannes Hilden (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of copyright holder nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,83 @@+# fuzzyset-haskell [](https://travis-ci.org/laserpants/fuzzyset-haskell)++A fuzzy string set data structure for approximate string matching. This implementation is based on the Python and JavaScript libraries with the same name:++* [JavaScript version](https://github.com/Glench/fuzzyset.js)+* [Python version](https://github.com/axiak/fuzzyset)++## How to use++Make sure the `OverloadedStrings` pragma is enabled. Then there are just three steps:++1. Create a set using one of `defaultSet`, `mkSet`, or `fromList`.+2. To add entries, use `add`, `addToSet`, or `addMany`.+3. Then query the set with `get`, `getOne`, or `getWithMinScore`.++```+>>> defaultSet `add` "Jurassic Park" `add` "Terminator" `add` "The Matrix" `getOne` "percolator"+Just "Terminator"+```++```+>>> defaultSet `add` "Shaggy Rogers" `add` "Fred Jones" `add` "Daphne Blake" `add` "Velma Dinkley" `get` "Shaggy Jones"+[(0.7692307692307693,"Shaggy Rogers"),(0.5,"Fred Jones")]+```++There are also a few functions to inspect the set.++### More examples++```+{-# 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")]+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import Data.FuzzySet++main :: IO ()+main = return ()
+ fuzzyset.cabal view
@@ -0,0 +1,58 @@+name: fuzzyset+version: 0.1.0.0+synopsis: Fuzzy set for approximate string matching+description: This library is based on the Python and JavaScript libraries with the same name.+homepage: https://github.com/laserpants/fuzzyset-haskell+license: BSD3+license-file: LICENSE+author: Johannes Hildén+maintainer: hildenjohannes@gmail.com+copyright: 2017 Johannes Hildén+category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ hs-source-dirs: src+ exposed-modules: Data.FuzzySet+ , Data.FuzzySet.Internal+ , Data.FuzzySet.Lens+ , Data.FuzzySet.Types+ , Data.FuzzySet.Util+ build-depends: base >= 4.7 && < 5+ , base-unicode-symbols ==0.2.2.4+ , data-default ==0.7.1.1+ , lens ==4.15.4+ , text ==1.2.2.2+ , text-metrics ==0.3.0+ , unordered-containers ==0.2.8.0+ , vector ==0.12.0.1+ default-language: Haskell2010++executable fuzzyset-exe+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends: base+ , fuzzyset+ default-language: Haskell2010++test-suite fuzzyset-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ build-depends: base+ , base-unicode-symbols ==0.2.2.4+ , hspec ==2.4.4+ , fuzzyset+ , lens ==4.15.4+ , text ==1.2.2.2+ , ieee754 ==0.8.0+ , unordered-containers ==0.2.8.0+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/laserpants/fuzzyset-haskell
+ src/Data/FuzzySet.hs view
@@ -0,0 +1,262 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnicodeSyntax #-}++-- |+--+-- Module : Data.FuzzySet+-- Copyright : (c) 2017 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 the same+-- name: +--+-- * [JavaScript version](http://glench.github.io/fuzzyset.js/)+-- * [Python version](https://github.com/axiak/fuzzyset)++module Data.FuzzySet+ ( + -- * How to use+ -- $howto++ -- * Types+ FuzzySet+ , Size++ -- * API++ -- ** Initializing+ , mkSet+ , defaultSet+ , fromList++ -- ** Adding+ , add+ , addToSet+ , addMany++ -- ** Retrieving+ , get+ , getWithMinScore+ , getOne++ -- ** Inspecting+ , size+ , isEmpty+ , values+ ) where++import Data.Foldable.Unicode+import Data.FuzzySet.Internal+import Data.FuzzySet.Lens+import Data.FuzzySet.Types+import Data.FuzzySet.Util+import Data.HashMap.Strict ( HashMap, elems, insert, unionWith )+import Data.Maybe ( fromMaybe )+import Data.List ( find )+import Data.Text ( Text )+import Prelude.Unicode hiding ( (∈) )++import qualified Data.Text as Text+import qualified Data.HashMap.Strict as HashMap+import qualified Data.Vector as Vector++-- $howto+--+-- Make sure the @OverloadedStrings@ pragma is enabled. Then there are just +-- three steps:+--+-- 1. Create a set using one of 'defaultSet', 'mkSet', or 'fromList'.+-- 2. To add entries, use 'add', 'addToSet', or 'addMany'.+-- 3. Then query the set with 'get', 'getOne', or 'getWithMinScore'.+--+-- >>> defaultSet `add` "Jurassic Park" `add` "Terminator" `add` "The Matrix" `getOne` "percolator"+-- Just "Terminator"+--+-- >>> defaultSet `add` "Shaggy Rogers" `add` "Fred Jones" `add` "Daphne Blake" `add` "Velma Dinkley" `get` "Shaggy Jones"+-- [(0.7692307692307693,"Shaggy Rogers"),(0.5,"Fred Jones")]+--+-- There are also a few functions to [inspect](#g:7) the set.+--+-- == More examples+--+-- > {-# 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")]++-- | Initialize a 'FuzzySet'.+mkSet ∷ Size + -- ^ The lower bound of gram sizes to use (inclusive)+ → Size + -- ^ The upper bound of gram sizes to use (inclusive)+ → Bool + -- ^ Whether to use [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 +mkSet lower upper levenshtein = FuzzySet lower upper levenshtein ε ε ε++-- | Try to match the given 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.+getWithMinScore ∷ Double+ -- ^ A minimum score+ → FuzzySet+ -- ^ The fuzzy string set to compare the string against+ → Text+ -- ^ The lookup query+ → [(Double, Text)]+ -- ^ A list of results (score and matched value pairs)+getWithMinScore minScore FuzzySet{..} val =+ case HashMap.lookup key exactSet of+ Just v → [(1, v)]+ Nothing → fromMaybe [] $ find (not ∘ null) (getMatch ctx <$> sizes)+ where+ ctx = GetContext key minScore FuzzySet{..}+ key = Text.toLower val+ sizes = reverse [gramSizeLower .. gramSizeUpper]++-- | 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.+get ∷ FuzzySet+ -- ^ The fuzzy string set to compare the string against+ → Text+ -- ^ The lookup query+ → [(Double, Text)]+ -- ^ A list of results (score and matched value pairs)+get = getWithMinScore 0.33++-- | Try to match the given string against the entries in the set, and return+-- the closest match, if one is found.+getOne ∷ FuzzySet+ -- ^ The fuzzy string set to compare the string against+ → Text+ -- ^ The lookup query+ → Maybe Text+ -- ^ 'Just' the result, if one was found, otherwise 'Nothing'+getOne set val = + case get set val of+ [] → Nothing+ xs → Just (snd (head xs))++-- | Add an entry to the set, or do nothing if a key identical to the provided+-- value already exists in the set.+add ∷ FuzzySet+ -- ^ Fuzzy string set to add the entry to+ → Text+ -- ^ The new entry+ → FuzzySet+ -- ^ The updated set+add set = fst ∘ addToSet set++-- | Add an entry to the set and return a pair with the new set, and a boolean+-- to indicate if a new entry was inserted, or not.+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 FuzzySet{..} val+ | key ∈ exactSet = (FuzzySet{..}, False)+ | otherwise =+ let sizes = [gramSizeLower .. gramSizeUpper]+ in (foldr ξ FuzzySet{..} sizes &_exactSet %~ insert key val, True)+ where+ key = Text.toLower val+ ξ size fs =+ let dict' = flip (:) [] ∘ GramInfo index <$> gramMap (normalized val) size+ item = FuzzySetItem (gramMap key size & elems & norm) key+ index = fs ^._items ^? ix size ^._Just & Vector.length+ in over _matchDict (\dict → unionWith (⧺) dict dict')+ $ over (_items.at size) (Just ∘ (`Vector.snoc` item)+ ∘ fromMaybe Vector.empty) fs++-- | Add a list of entries to the set, in one go. +--+-- > addMany = foldr (flip add)+addMany ∷ FuzzySet+ -- ^ Fuzzy string set to add the entries to+ → [Text]+ -- ^ A list of new entries+ → FuzzySet+ -- ^ A new fuzzy string set+addMany = foldr (flip add)++-- | Create a fuzzy string set with entries from the given list.+--+-- @fromList = addMany defaultSet@+fromList ∷ [Text] → FuzzySet+fromList = addMany defaultSet ++-- | Return the number of entries in the set.+--+-- >>> size (defaultSet `add` "map" `add` "cap")+-- 2+size ∷ FuzzySet → Int+size = HashMap.size ∘ exactSet++-- | Return a boolean indicating whether the provided set is empty.+--+-- >>> isEmpty (fromList [])+-- True+isEmpty ∷ FuzzySet → Bool+isEmpty = HashMap.null ∘ exactSet++-- | Return the elements of the set.+--+-- >>> values (fromList ["bass", "craze", "space", "lace", "daze", "haze", "ace", "maze"])+-- ["space","daze","bass","maze","ace","craze","lace","haze"]+values ∷ FuzzySet → [Text]+values = elems ∘ exactSet
+ src/Data/FuzzySet/Internal.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE UnicodeSyntax #-}+module Data.FuzzySet.Internal where++import Data.Function ( on )+import Data.FuzzySet.Lens+import Data.FuzzySet.Types+import Data.FuzzySet.Util+import Data.HashMap.Strict ( HashMap, alter, empty, elems, foldrWithKey )+import Data.Maybe ( fromMaybe )+import Data.List ( sortBy )+import Data.Text ( Text )+import Prelude.Unicode++import qualified Data.HashMap.Strict as HashMap+import qualified Data.Text as Text+import qualified Data.Vector as Vector++getMatch ∷ GetContext → Size → [(Double, Text)]+getMatch GetContext{..} size = match <$$> filtered+ where+ match α = set ^._exactSet.ix α+ filtered = filter ((<) minScore ∘ fst) sorted+ μ p = p & _1.~ distance (p ^._2) key+ sorted = sortBy (flip compare `on` fst) $+ let rs = results GetContext{..} size+ in if set ^._useLevenshtein+ then take 50 (μ <$> rs)+ else rs++results ∷ GetContext → Size → [(Double, Text)]+results GetContext{..} size = ζ <$> HashMap.toList (matches set grams)+ where+ grams = gramMap key size+ normal = norm (elems grams)+ ζ (index, score) =+ let FuzzySetItem{..} = Vector.unsafeIndex (set ^._items.ix size) index+ in (fromIntegral score / (normal × vectorMagnitude), normalizedEntry)++matches ∷ FuzzySet → HashMap Text Int → HashMap Int Int+matches set = foldrWithKey ζ empty+ where+ ζ gram occ m = foldr (\GramInfo{..} →+ alter (pure ∘ (+) (occ × gramCount) ∘ fromMaybe 0) itemIndex)+ m (set ^._matchDict.ix gram)++-- | Normalize the input string, call 'grams' on the normalized input, and then+-- translate the result to a 'HashMap' with the /n/-grams as keys and 'Int'+-- values corresponding to the number of occurences of the key in the+-- generated gram list.+--+-- >>> gramMap "xxxx" 2+-- fromList [("-x",1), ("xx",3), ("x-",1)]+--+-- >>> Data.HashMap.Strict.lookup "nts" (gramMap "intrent'srestaurantsomeoftrent'saunt'santswantsamtorentsomepants" 3)+-- Just 8+gramMap ∷ Text+ -- ^ An input string+ → Size+ -- ^ The gram size /n/, which must be at least /2/+ → HashMap Text Int+ -- ^ A mapping from /n/-gram keys to the number of occurrences of the+ -- key in the list returned by 'grams' (i.e., the list of all+ -- /n/-length substrings of the input enclosed in hyphens).+gramMap val size = foldr ζ ε (grams val size)+ where+ ζ = alter (pure ∘ succ ∘ fromMaybe 0)++-- | Break apart the normalized input string into a list of /n/-grams. For+-- instance, the string "Destroido Corp." is first normalized into the+-- form "destroido corp", and then enclosed in hyphens, so that it becomes+-- "-destroido corp-". The /3/-grams generated from this normalized string are+--+-- > "-de", "des", "est", "str", "tro", "roi", "oid", "ido", "do ", "o c", " co", "cor", "orp", "rp-"+--+-- Given a normalized string of length /s/, we take all substrings of length+-- /n/, letting the offset range from \(0 \text{ to } s + 2 − n\). The number+-- of /n/-grams for a normalized string of length /s/ is thus+-- \(s + 2 − n + 1 = s − n + 3\), where \(0 < n < s − 2\).+grams ∷ Text -- ^ An input string+ → Size -- ^ The variable /n/, which must be at least /2/+ → [Text] -- ^ A /k/-length list of grams of size /n/,+ -- with \(k = s − n + 3\)+grams val size+ | size < 2 = error "gram size must be >= 2"+ | otherwise = ($ str) ∘ substr size <$> [0 .. Text.length str − size]+ where+ str = normalized val `enclosedIn` '-'
+ src/Data/FuzzySet/Lens.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE TemplateHaskell #-}+module Data.FuzzySet.Lens+ ( module Control.Lens+ , _items+ , _matchDict+ , _exactSet+ , _useLevenshtein+ , _gramSizeLower+ , _gramSizeUpper+ , _vectorMagnitude+ , _normalizedEntry+ ) where++import Control.Lens+import Data.FuzzySet.Types++import qualified Data.HashMap.Strict as HashMap+import qualified Data.Vector as Vector++makeLensesFor+ [ ("items" , "_items")+ , ("matchDict" , "_matchDict")+ , ("exactSet" , "_exactSet")+ , ("useLevenshtein" , "_useLevenshtein")+ , ("gramSizeLower" , "_gramSizeLower")+ , ("gramSizeUpper" , "_gramSizeUpper")+ ] ''FuzzySet++makeLensesFor+ [ ("vectorMagnitude" , "_vectorMagnitude")+ , ("normalizedEntry" , "_normalizedEntry")+ ] ''FuzzySetItem
+ src/Data/FuzzySet/Types.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE UnicodeSyntax #-}+module Data.FuzzySet.Types where++import Data.Default+import Data.Text ( Text )+import Data.HashMap.Strict ( HashMap )+import Data.Vector ( Vector )++data FuzzySetItem = FuzzySetItem+ { vectorMagnitude ∷ !Double+ , normalizedEntry ∷ !Text+ } deriving (Eq, Show)++data GramInfo = GramInfo+ { itemIndex ∷ !Int+ , gramCount ∷ !Int+ } deriving (Eq, Show)++-- | Type alias for representing gram sizes.+type Size = Int+type ExactSet = HashMap Text Text+type MatchDict = HashMap Text [GramInfo]+type ItemMap = HashMap Size (Vector FuzzySetItem)++-- | Opaque fuzzy string set data type. Use 'Data.FuzzySet.defaultSet', +-- 'Data.FuzzySet.mkSet', or 'Data.FuzzySet.fromList' to create 'FuzzySet's.+data FuzzySet = FuzzySet+ { gramSizeLower ∷ !Size+ , gramSizeUpper ∷ !Size+ , useLevenshtein ∷ !Bool+ , exactSet ∷ !ExactSet+ , matchDict ∷ !MatchDict+ , items ∷ !ItemMap+ } deriving (Eq, Show)++-- | See 'defaultSet'.+instance Default FuzzySet where+ def = defaultSet++data GetContext = GetContext+ { key ∷ !Text+ , minScore ∷ !Double+ , set ∷ !FuzzySet+ } deriving (Show)++-- | A 'FuzzySet' with the following field values:+--+-- > { gramSizeLower = 2+-- > , gramSizeUpper = 3+-- > , useLevenshtein = True+-- > , exactSet = ε+-- > , matchDict = ε+-- > , items = ε }+defaultSet ∷ FuzzySet+defaultSet = FuzzySet 2 3 True mempty mempty mempty+
+ src/Data/FuzzySet/Util.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE UnicodeSyntax #-}+module Data.FuzzySet.Util+ ( distance+ , enclosedIn+ , normalized+ , norm+ , substr+ , ε+ , (<$$>)+ , (−)+ , (×)+ ) where++import Data.Char ( isAlphaNum, isSpace )+import Data.HashMap.Strict ( HashMap, empty )+import Data.Text ( Text, cons, snoc )+import Data.Text.Metrics+import Prelude.Unicode++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+normalized = Text.filter word ∘ Text.toLower+ where+ word ch+ | isAlphaNum ch = True+ | isSpace ch = True+ | (≡) ',' ch = True+ | otherwise = False++-- | Return /n/ characters starting from offset /m/ in the input string.+substr ∷ Int -- ^ Length of the substring+ → Int -- ^ A 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 the character /ch/ at the beginning and end of the input string.+enclosedIn ∷ Text → Char → Text+{-# INLINE enclosedIn #-}+enclosedIn str ch = ch `cons` str `snoc` ch++-- | Returns the euclidian norm, or /magnitude/, of the input list interpreted +-- as a vector. That is, \( \sqrt{ \sum_{i=0}^n a_i^2 } \) for the input +-- \( \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.+distance ∷ Text → Text → Double+distance s t = fromRational (toRational d)+ where+ d = levenshteinNorm s t++-- | @(\<$$\>) = fmap ∘ fmap@+(<$$>) ∷ (Functor f, Functor g) ⇒ (a → b) → g (f a) → g (f b)+(<$$>) = fmap ∘ fmap+{-# INLINE (<$$>) #-}++-- | Empty HashMap+ε ∷ HashMap k v+ε = empty+{-# INLINE ε #-}++-- | Unicode minus sign symbol. Slightly longer than the hyphen-minus commonly+-- used, U+2212 aligns naturally with the horizontal bar of the + symbol.+(−) ∷ Num α ⇒ α → α → α+(−) = (-)+{-# INLINE (−) #-}++-- | Another unicode operator. This one for multiplication.+(×) ∷ Num α ⇒ α → α → α+(×) = (*)+{-# INLINE (×) #-}
+ test/Spec.hs view
@@ -0,0 +1,654 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UnicodeSyntax #-}++import Control.Exception ( evaluate )+import Control.Lens+import Control.Monad ( zipWithM_ )+import Data.AEq+import Data.FuzzySet hiding ( fromList )+import Data.FuzzySet.Internal+import Data.FuzzySet.Lens+import Data.FuzzySet.Types+import Data.FuzzySet.Util+import Data.HashMap.Strict ( HashMap, fromList, empty )+import Data.List ( sortOn )+import Data.Maybe+import Data.Monoid+import Data.Monoid.Unicode+import Data.Text ( Text, pack, unpack )+import Prelude.Unicode+import Test.Hspec++import qualified Data.Text as Text+import qualified Data.HashMap.Strict as Map++shouldBeTrue ∷ Bool → Expectation+shouldBeTrue = shouldBe True++shouldBeCloseTo ∷ Double → Double → Expectation+shouldBeCloseTo q r = shouldBeTrue (q ~== r)++shouldNotBeCloseTo ∷ Double → Double → Expectation+shouldNotBeCloseTo q r = shouldBeTrue $ not (q ~== r)++lookup0 ∷ Text → HashMap Text Int → Int+lookup0 = Map.lookupDefault 0++checkGramsCount ∷ Text → Size → 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 <$> set^._items.at n._Just^?ix 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 (set^._matchDict.ix gram `shouldBe` entry)+ where+ message = "should return a match dict entry "+ ⊕ show entry ⊕ " for " ⊕ show gram++checkExactSet ∷ FuzzySet → [(Text, Text)] → SpecWith ()+checkExactSet set xs =+ it ("should have exactSet = " ⊕ show xs) $+ exactSet set `shouldBe` fromList xs++checkGrams ∷ Text → Size → [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 → Size → [(Text, Int)] → SpecWith ()+checkGramMap txt size r =+ describe msg $ it ("should return " ⊕ show r)+ (gramMap txt size `shouldBe` fromList r)+ where+ msg = "gramMap " ⊕ show txt ⊕ " " ⊕ show size++checkGramMapKeys ∷ Text → Size → [(Text, Int)] → SpecWith ()+checkGramMapKeys txt size keys =+ describe msg $ mapM_ (uncurry $ checkMapKey grams) keys+ where+ msg = "gramMap " ⊕ show txt ⊕ " " ⊕ show size+ grams = gramMap txt size++checkMatches ∷ FuzzySet → Text → Size → [(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 $ Map.toList $ matches set (gramMap txt size)+ f (a, b) = (set ^._items.ix size ^? ix a._normalizedEntry & fromJust, b)+ msg = "matches " ⊕ show (set^._exactSet) ⊕ " "+ ⊕ "(gramMap " ⊕ 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 (set^._exactSet) ⊕ ") " ⊕ 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 = hspec $ do++ 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 3 4 True mempty mempty mempty+ `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 2 5 True mempty mempty mempty+ `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 2 3 False empty empty empty+ `add` "Alaska" `add` "Alabama" `add` "Guam"++testset_5 ∷ FuzzySet+testset_5 = addMany (FuzzySet 2 3 False empty empty empty) states++testset_6 ∷ FuzzySet+testset_6 = addMany defaultSet states++testset_7 ∷ FuzzySet+testset_7 = addMany (FuzzySet 2 4 True empty empty empty) 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" ]