diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,30 +1,29 @@ -Copyright Johannes Hilden (c) 2017 +BSD 3-Clause License +Copyright (c) 2017-2019, Heikki Johannes Hildén 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. +1. 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. +2. 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. +3. Neither the name of the copyright holder nor the names of its + 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 +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 HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,177 +1,10 @@ -# fuzzyset-haskell [![Build Status](https://img.shields.io/travis/laserpants/fuzzyset-haskell/master.svg?style=flat)](https://travis-ci.org/laserpants/fuzzyset-haskell) [![License](https://img.shields.io/badge/license-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause) [![Language](https://img.shields.io/badge/language-Haskell-yellow.svg)](https://www.haskell.org/) [![Hackage](https://img.shields.io/hackage/v/fuzzyset.svg)](http://hackage.haskell.org/package/fuzzyset) - -## Table of Contents - -* [About](#about) -* [Install](#install) -* [How to use](#how-to-use) -* [API](#api) -* [Examples](#examples) - -## About - -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) - -## Install - -``` -cabal install fuzzyset -``` - -For details, see [Hackage docs](http://hackage.haskell.org/package/fuzzyset). This library is also available on [Stackage](https://www.stackage.org/package/fuzzyset). To install using [Stack](https://www.haskellstack.org/): - -``` -stack install 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")] -``` - -See [here](https://github.com/laserpants/fuzzyset-haskell/blob/master/README.md#examples) for more examples. - -## API - -### Initializing - -#### `mkSet :: Size -> Size -> Bool -> FuzzySet` - -* `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 to determine the score -* `FuzzySet` An empty fuzzy string set - -Initialize a FuzzySet. - -#### `defaultSet :: FuzzySet` - -A FuzzySet with the following field values: - -``` -{ gramSizeLower = 2 -, gramSizeUpper = 3 -, useLevenshtein = True -, exactSet = ε -, matchDict = ε -, items = ε } -``` - -#### `fromList :: [Text] -> FuzzySet` - -Create a fuzzy string set with entries from the given list. - -``` -fromList = addMany defaultSet -``` - -### Adding - -#### `add :: FuzzySet -> Text -> FuzzySet` - -* `FuzzySet` Fuzzy string set to add the entry to -* `Text` The new entry -* `FuzzySet` The updated set - -Add an entry to the set, or do nothing if a key identical to the provided value already exists in the set. - -#### `addToSet :: FuzzySet -> Text -> (FuzzySet, Bool)` - -* `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. - -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. - -#### `addMany :: FuzzySet -> [Text] -> FuzzySet` - -* `FuzzySet` Fuzzy string set to add the entries to -* `[Text]` A list of new entries -* `FuzzySet` A new fuzzy string set - -Add a list of entries to the set, in one go. - -``` -addMany = foldr (flip add) -``` - -### Retrieving - -#### `get :: FuzzySet -> Text -> [(Double, Text)]` - -* `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) - -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. - -#### `getWithMinScore :: Double -> FuzzySet -> Text -> [(Double, Text)]` - -* `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) - -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. - -#### `getOne :: FuzzySet -> Text -> Maybe Text` - -* `FuzzySet` The fuzzy string set to compare the string against -* `Text` The lookup query -* `Maybe Text` Return `Just` the result, if a match was found, otherwise `Nothing` - -Try to match the given string against the entries in the set, and return the closest match, if one is found. - -### Inspecting - -There are also a few functions to inspect the set. - -#### `size :: FuzzySet -> Int` - -Return the number of entries in the set. - -``` ->>> size (defaultSet `add` "map" `add` "cap") -2 -``` - -#### `isEmpty :: FuzzySet -> Bool` - -Return a boolean to indicate whether the set is empty. - -``` ->>> isEmpty (fromList []) -True -``` - -#### `values :: FuzzySet -> [Text]` - -Return the elements of the set. +# fuzzyset [![Build Status](https://img.shields.io/travis/laserpants/fuzzyset-haskell/master.svg?style=flat)](https://travis-ci.org/laserpants/fuzzyset-haskell) [![License](https://img.shields.io/badge/license-BSD%203--Clause-blue.svg)](https://opensource.org/licenses/BSD-3-Clause) [![Language](https://img.shields.io/badge/language-Haskell-yellow.svg)](https://www.haskell.org/) [![Hackage](https://img.shields.io/hackage/v/fuzzyset.svg)](http://hackage.haskell.org/package/fuzzyset) -``` ->>> values (fromList ["bass", "craze", "space", "lace", "daze", "haze", "ace", "maze"]) -["space","daze","bass","maze","ace","craze","lace","haze"] -``` +A fuzzy string set data structure for approximate string matching. ## Examples -``` +```haskell {-# LANGUAGE OverloadedStrings #-} module Main where @@ -197,7 +30,7 @@ The output of this program is: -``` +```haskell (0.7142857142857143,"Virgin Islands") (0.5714285714285714,"Rhode Island") (0.44,"Northern Marianas Islands") @@ -206,7 +39,7 @@ Using the same definition of `statesSet` from previous example: -``` +```haskell >>> get statesSet "Why-oh-me-ing" [(0.5384615384615384,"Wyoming")] diff --git a/fuzzyset.cabal b/fuzzyset.cabal --- a/fuzzyset.cabal +++ b/fuzzyset.cabal @@ -1,50 +1,62 @@ -name: fuzzyset -version: 0.1.1 -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: 2019 Johannes Hildén -category: Data -build-type: Simple -extra-source-files: README.md -cabal-version: >= 1.10 +cabal-version: 1.12 +-- This file has been generated from package.yaml by hpack version 0.31.2. +-- +-- see: https://github.com/sol/hpack +-- +-- hash: ca8c7475d857875ca00bad57120016509b82a9a1cf5d1e68c77389188fbf0096 + +name: fuzzyset +version: 0.2.0 +synopsis: Fuzzy set for approximate string matching +description: This library is based on the Python and JavaScript libraries with similar names. +category: Data +homepage: https://github.com/laserpants/fuzzyset-haskell +author: Johannes Hildén +maintainer: hildenjohannes@gmail.com +copyright: 2017-2019 Johannes Hildén +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + 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 && < 0.3 - , data-default >= 0.7.1.1 && < 0.8 - , lens >= 4.15.4 - , text >= 1.2.2.2 - , text-metrics >= 0.3.0 && < 0.4 - , unordered-containers >= 0.2.8.0 - , vector >= 0.12.0.1 - default-language: Haskell2010 + exposed-modules: + Data.FuzzySet + Data.FuzzySet.Internal + Data.FuzzySet.Types + Data.FuzzySet.Util + other-modules: + Paths_fuzzyset + hs-source-dirs: + src + build-depends: + base >=4.7 && <5 + , data-default >=0.7.1.1 && <0.8 + , text >=1.2.3.1 && <1.3 + , text-metrics >=0.3.0 && <0.4 + , unordered-containers >=0.2.10.0 && <0.3 + , vector >=0.12.0.3 && <0.13 + 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 && < 0.3 - , hspec >= 2.4.4 - , fuzzyset - , lens >= 4.15.4 - , text >= 1.2.2.2 - , ieee754 >= 0.8.0 && < 0.9 - , 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 + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Helpers + Paths_fuzzyset + hs-source-dirs: + test + ghc-options: -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.8 + , ieee754 >=0.8.0 && <0.9 + , text >=1.2.3.1 && <1.3 + , text-metrics >=0.3.0 && <0.4 + , unordered-containers >=0.2.10.0 && <0.3 + , vector >=0.12.0.3 && <0.13 + default-language: Haskell2010 diff --git a/src/Data/FuzzySet.hs b/src/Data/FuzzySet.hs --- a/src/Data/FuzzySet.hs +++ b/src/Data/FuzzySet.hs @@ -1,77 +1,77 @@ {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UnicodeSyntax #-} -- | -- -- Module : Data.FuzzySet --- Copyright : (c) 2017 Johannes Hildén +-- Copyright : (c) 2017-2019 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) +-- 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 - -- $howto + ( + -- * How to use this library + -- $howto - -- * Types - FuzzySet - , Size + -- * Types + FuzzySet - -- * API + -- * API - -- ** Initializing - , mkSet - , defaultSet - , fromList + -- ** Initializing + , emptySet + , defaultSet + , fromList - -- ** Adding - , add - , addToSet - , addMany + -- ** Adding + , add + , addToSet + , addMany - -- ** Retrieving - , get - , getWithMinScore - , getOne + -- ** Retrieving + , get + , getWithMinScore + , getOne + , getOneWithMinScore - -- ** Inspecting - , size - , isEmpty - , values - ) where + -- ** Inspecting + , size + , isEmpty + , values -import Data.Foldable.Unicode + -- * Implementation + -- $implementation + + ) where + +import Data.Default (Default, def) 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 +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 -- $howto -- --- Make sure the @OverloadedStrings@ pragma is enabled. Then there are just --- three steps: +-- Make sure the @OverloadedStrings@ pragma is enabled. After that, three steps +-- are typically involved: -- --- 1. Create a set using one of 'defaultSet', 'mkSet', or 'fromList'. +-- 1. Create a set using one of 'defaultSet', 'emptySet', or 'fromList'. -- 2. To add entries, use 'add', 'addToSet', or 'addMany'. --- 3. Then query the set with 'get', 'getOne', or 'getWithMinScore'. +-- 3. Query the set with 'get', 'getOne', 'getWithMinScore', or 'getOneWithMinScore'. -- -- >>> defaultSet `add` "Jurassic Park" `add` "Terminator" `add` "The Matrix" `getOne` "percolator" -- Just "Terminator" @@ -79,15 +79,15 @@ -- >>> 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. +-- There are also a few functions to inspect sets: 'size', 'isEmpty', and 'values'. -- -- == 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" @@ -102,7 +102,7 @@ -- > , "Wyoming" ] -- > -- > statesSet = fromList states --- > +-- > -- > main = mapM_ print (get statesSet "Burger Islands") -- -- The output of this program is: @@ -119,7 +119,7 @@ -- -- > >>> get statesSet "Connect a cat" -- > [(0.6923076923076923,"Connecticut")] --- +-- -- > >>> get statesSet "Transylvania" -- > [(0.75,"Pennsylvania"),(0.3333333333333333,"California"),(0.3333333333333333,"Arkansas"),(0.3333333333333333,"Kansas")] -- @@ -131,132 +131,351 @@ -- -- > >>> 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\). Since the cosine similarity is a measure of the (cosine of the) +-- angle between two vectors, it 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 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) +-- | 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. +-- +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 - ctx = GetContext key minScore FuzzySet{..} - key = Text.toLower val - sizes = reverse [gramSizeLower .. gramSizeUpper] + 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. -get ∷ FuzzySet +-- 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. +-- +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 + -> 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. +-- +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. -getOne ∷ FuzzySet - -- ^ The fuzzy string set to compare the string against - → Text - -- ^ The lookup query - → Maybe Text - -- ^ 'Just' the result, if a match was found, otherwise 'Nothing' -getOne set val = - case get set val of - [] → Nothing - xs → Just (snd (head xs)) +-- the closest match, if one is found. A minimum score of 0.33 is used. To +-- specify a different threshold value, instead use 'getOneWithMinScore'. +-- +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 identical to the provided --- value already exists in the set. -add ∷ FuzzySet - -- ^ Fuzzy string set to add the entry to - → Text + +-- | Add an entry to the set, or do nothing if a key that matches the string +-- already exists in the set. +-- +add + :: FuzzySet + -- ^ Set to add the string to + -> Text -- ^ The new entry - → FuzzySet - -- ^ The updated set -add set = fst ∘ addToSet set + -> FuzzySet + -- ^ An updated set +add fuzzySet = + fst . addToSet fuzzySet --- | 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) + +-- | 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. +-- +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 = - let sizes = [gramSizeLower .. gramSizeUpper] - in (foldr ξ FuzzySet{..} sizes &_exactSet %~ insert key val, True) + ( newSet |> updateExactSet value, 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 + newSet = foldr addSize set (enumFromTo lower upper) + key = Text.toLower value --- | Add a list of entries to the set, in one go. + 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. -- --- > 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) +-- @addMany = foldr (flip add)@ +-- +addMany :: FuzzySet -> [Text] -> FuzzySet +addMany = + foldr (flip add) --- | Create a fuzzy string set with entries from the given list. + +-- | Create a set from a list of entries, using the default settings. -- -- @fromList = addMany defaultSet@ -fromList ∷ [Text] → FuzzySet -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 +-- >>> size (defaultSet `add` "bork" `add` "bork" `add` "bork") +-- 1 +-- +size :: FuzzySet -> Int +size = + HashMap.size . exactSet --- | Return a boolean indicating whether the provided set is empty. + +-- | Return a boolean indicating whether the set is empty. -- -- >>> isEmpty (fromList []) -- True -isEmpty ∷ FuzzySet → Bool -isEmpty = HashMap.null ∘ exactSet +-- >>> isEmpty $ fromList ["Aramis", "Porthos", "Athos"] +-- False +-- +isEmpty :: FuzzySet -> Bool +isEmpty = + HashMap.null . exactSet --- | Return the elements of the set. + +-- | 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 +-- +values :: FuzzySet -> [Text] +values = + elems . exactSet diff --git a/src/Data/FuzzySet/Internal.hs b/src/Data/FuzzySet/Internal.hs --- a/src/Data/FuzzySet/Internal.hs +++ b/src/Data/FuzzySet/Internal.hs @@ -1,89 +1,180 @@ -{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE UnicodeSyntax #-} -module Data.FuzzySet.Internal where +{-# LANGUAGE OverloadedStrings #-} -import Data.Function ( on ) -import Data.FuzzySet.Lens +-- 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 + +import Data.Function ((&)) 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 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.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 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 +-- | Alternative syntax for the reverse function application operator @(&)@, +-- known also as the /pipe/ operator. +-- +(|>) :: a -> (a -> b) -> b +(|>) = (&) +infixl 1 |> -results ∷ GetContext → Size → [(Double, Text)] -results GetContext{..} size = ζ <$> HashMap.toList (matches set grams) + +-- | 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. +-- +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 - 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) + 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) -matches ∷ FuzzySet → HashMap Text Int → HashMap Int Int -matches set = foldrWithKey ζ empty + +-- | 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 )) where - ζ gram occ m = foldr (\GramInfo{..} → - alter (pure ∘ (+) (occ × gramCount) ∘ fromMaybe 0) itemIndex) - m (set ^._matchDict.ix gram) + 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 --- | 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. + queryMagnitude = norm (elems queryVector) + queryVector = gramVector query gramSize + itemsVector = fromMaybe mempty (gramSize `HashMap.lookup` items) + + fun index score list = + case itemsVector !? index of + Nothing -> + list + + Just FuzzySetItem{..} -> + ( fromIntegral score / (queryMagnitude * vectorMagnitude) + , normalizedEntry + ) : list + + +-- | 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. -- --- >>> gramMap "xxxx" 2 +-- >>> gramVector "xxxx" 2 -- fromList [("-x",1), ("xx",3), ("x-",1)] -- --- >>> Data.HashMap.Strict.lookup "nts" (gramMap "intrent'srestaurantsomeoftrent'saunt'santswantsamtorentsomepants" 3) +-- The substring @"xx"@ appears three times in the normalized string: +-- +-- >>> grams "xxxx" 2 +-- ["-x","xx","xx","xx","x-"] +-- +-- >>> Data.HashMap.Strict.lookup "nts" (gramVector "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) +-- +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) where - ζ = alter (pure ∘ succ ∘ fromMaybe 0) + fun = HashMap.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 + +-- | 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. -- --- > "-de", "des", "est", "str", "tro", "roi", "oid", "ido", "do ", "o c", " co", "cor", "orp", "rp-" +-- /Example:/ +-- The string @"Destroido Corp."@ is first normalized to @"destroido corp"@, +-- and then enclosed in hyphens, so that it becomes @"-destroido corp-"@. The +-- trigrams generated from this normalized string are: -- --- 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] +-- > [ "-de" +-- > , "des" +-- > , "est" +-- > , "str" +-- > , "tro" +-- > , "roi" +-- > , "oid" +-- > , "ido" +-- > , "do " +-- > , "o c" +-- > , " co" +-- > , "cor" +-- > , "orp" +-- > , "rp-" +-- > ] +-- +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 where - str = normalized val `enclosedIn` '-' + str = normalized value `enclosedIn` '-' + offsets = [0 .. Text.length str - size] diff --git a/src/Data/FuzzySet/Lens.hs b/src/Data/FuzzySet/Lens.hs deleted file mode 100644 --- a/src/Data/FuzzySet/Lens.hs +++ /dev/null @@ -1,29 +0,0 @@ -{-# 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 - -makeLensesFor - [ ("items" , "_items") - , ("matchDict" , "_matchDict") - , ("exactSet" , "_exactSet") - , ("useLevenshtein" , "_useLevenshtein") - , ("gramSizeLower" , "_gramSizeLower") - , ("gramSizeUpper" , "_gramSizeUpper") - ] ''FuzzySet - -makeLensesFor - [ ("vectorMagnitude" , "_vectorMagnitude") - , ("normalizedEntry" , "_normalizedEntry") - ] ''FuzzySetItem diff --git a/src/Data/FuzzySet/Types.hs b/src/Data/FuzzySet/Types.hs --- a/src/Data/FuzzySet/Types.hs +++ b/src/Data/FuzzySet/Types.hs @@ -1,56 +1,34 @@ -{-# LANGUAGE UnicodeSyntax #-} -module Data.FuzzySet.Types where +module Data.FuzzySet.Types + ( FuzzySetItem(..) + , GramInfo(..) + , FuzzySet(..) + ) where -import Data.Default -import Data.Text ( Text ) -import Data.HashMap.Strict ( HashMap ) -import Data.Vector ( Vector ) +import Data.HashMap.Strict (HashMap) +import Data.Vector (Vector) +import Data.Text (Text) + data FuzzySetItem = FuzzySetItem - { vectorMagnitude ∷ !Double - , normalizedEntry ∷ !Text - } deriving (Eq, Show) + { vectorMagnitude :: !Double + , normalizedEntry :: !Text + } deriving (Eq, Show) + data GramInfo = GramInfo - { itemIndex ∷ !Int - , gramCount ∷ !Int - } deriving (Eq, Show) + { 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: +-- | Main fuzzy string set data type. Use 'Data.FuzzySet.emptySet', +-- 'Data.FuzzySet.defaultSet', or 'Data.FuzzySet.fromList' to create sets. -- --- > { gramSizeLower = 2 --- > , gramSizeUpper = 3 --- > , useLevenshtein = True --- > , exactSet = ε --- > , matchDict = ε --- > , items = ε } -defaultSet ∷ FuzzySet -defaultSet = FuzzySet 2 3 True mempty mempty mempty - +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) diff --git a/src/Data/FuzzySet/Util.hs b/src/Data/FuzzySet/Util.hs --- a/src/Data/FuzzySet/Util.hs +++ b/src/Data/FuzzySet/Util.hs @@ -1,88 +1,81 @@ -{-# LANGUAGE CPP, UnicodeSyntax #-} module Data.FuzzySet.Util - ( distance - , enclosedIn - , normalized - , norm - , substr - , ε - , (<$$>) -#if !MIN_VERSION_base_unicode_symbols(0,2,3) - , (−) -#endif -#if !MIN_VERSION_base_unicode_symbols(0,2,4) - , (×) -#endif - ) where + ( normalized + , substr + , enclosedIn + , norm + , distance + ) 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 Data.Char (isAlphaNum, isSpace) +import Data.Text (Text, cons, snoc) +import Data.Text.Metrics (levenshteinNorm) +import qualified Data.Text as Text -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 +-- * 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 ch - | isAlphaNum ch = True - | isSpace ch = True - | (≡) ',' ch = True - | otherwise = False + 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 -- ^ A character offset /m/ - → Text -- ^ The input string - → Text -- ^ A substring of length /n/ +-- +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 +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 + +-- | Insert a character at the beginning and end of the given string. +-- +enclosedIn :: Text -> Char -> Text {-# INLINE enclosedIn #-} -enclosedIn str ch = ch `cons` str `snoc` ch +enclosedIn str char = + char `cons` str `snoc` char --- | 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 +-- | 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) --- | @(\<$$\>) = fmap ∘ fmap@ -(<$$>) ∷ (Functor f, Functor g) ⇒ (a → b) → g (f a) → g (f b) -(<$$>) = fmap ∘ fmap -{-# INLINE (<$$>) #-} --- | Empty HashMap -ε ∷ HashMap k v -ε = empty -{-# INLINE ε #-} - -#if !MIN_VERSION_base_unicode_symbols(0,2,3) --- | 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 (−) #-} -#endif - -#if !MIN_VERSION_base_unicode_symbols(0,2,4) --- | Another unicode operator. This one for multiplication. -(×) ∷ Num α ⇒ α → α → α -(×) = (*) -{-# INLINE (×) #-} -#endif +-- | Return the normalized Levenshtein distance between the two strings. +-- See . +-- +distance :: Text -> Text -> Double +distance s t = + fromRational (toRational dist) + where + dist = levenshteinNorm s t diff --git a/test/Helpers.hs b/test/Helpers.hs new file mode 100644 --- /dev/null +++ b/test/Helpers.hs @@ -0,0 +1,25 @@ +module Helpers where + +import Data.AEq +import Data.Text (Text) +import Test.Hspec + + +shouldBeTrue :: Bool -> Expectation +shouldBeTrue = + shouldBe True + + +shouldBeIn :: Eq a => a -> [a] -> Expectation +shouldBeIn x xs = + shouldBeTrue (x `elem` xs) + + +shouldBeCloseTo :: Double -> Double -> Expectation +shouldBeCloseTo q r = + shouldBeTrue (q ~== r) + + +shouldNotBeCloseTo :: Double -> Double -> Expectation +shouldNotBeCloseTo q r = + shouldBeTrue $ not (q ~== r) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,598 +1,716 @@ {-# 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 +{-# 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 =