language-spelling 0.1.2 → 0.2
raw patch · 3 files changed
+84/−35 lines, 3 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Language.Distance.Search.Class: class Search container full algo | container -> full, container -> algo where singleton str = insert str empty member x = not . null . query 0 x fromList = foldr insert empty
- Language.Distance.Search.Class: empty :: Search container full algo => container
- Language.Distance.Search.Class: fromList :: Search container full algo => [full] -> container
- Language.Distance.Search.Class: insert :: Search container full algo => full -> container -> container
- Language.Distance.Search.Class: member :: Search container full algo => full -> container -> Bool
- Language.Distance.Search.Class: query :: Search container full algo => Int -> full -> container -> [(full, Distance algo)]
- Language.Distance.Search.Class: singleton :: Search container full algo => full -> container
+ Data.BKTree: data BKTree s
+ Data.BKTree: empty :: Distance s -> BKTree s
+ Data.BKTree: insert :: s -> BKTree s -> BKTree s
+ Data.BKTree: query :: Int -> s -> BKTree s -> [(s, Int)]
+ Data.BKTree: type Distance s = s -> s -> Int
- Language.Distance.Search.BK: empty :: BKTree full algo
+ Language.Distance.Search.BK: empty :: (EditDistance sym algo, ListLike full sym) => BKTree full algo
- Language.Distance.Search.BK: insert :: (Eq sym, EditDistance sym algo, ListLike full sym) => full -> BKTree full algo -> BKTree full algo
+ Language.Distance.Search.BK: insert :: (EditDistance sym algo, ListLike full sym) => full -> BKTree full algo -> BKTree full algo
Files
- Data/BKTree.hs +69/−0
- Language/Distance/Search/BK.hs +11/−32
- language-spelling.cabal +4/−3
+ Data/BKTree.hs view
@@ -0,0 +1,69 @@+-- | Implementation of a BK-tree: <https://en.wikipedia.org/wiki/Bk-tree>+module Data.BKTree+ ( -- * Types+ Distance+ , BKTree+ -- * Operations+ , empty+ , insert+ , query+ ) where++import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap++type Distance s = s -> s -> Int++data BKTree s =+ BKTree !(BK s) (Distance s)++data BK s+ = EmptyBK+ | BK !s !(IntMap (BK s))++narrow :: Int -> Int -> IntMap a -> IntMap a+narrow n m im | n == m = IntMap.fromList (maybe [] (\v -> [(n, v)]) (IntMap.lookup n im))+narrow n m im | otherwise = insMaybe m res pr+ where+ (_, pl, res0) = IntMap.splitLookup n im+ (res, pr, _) = IntMap.splitLookup m (insMaybe n res0 pl)+ insMaybe k im' = maybe im' (\v -> IntMap.insert k v im')++empty :: Distance s -- ^ The distance function \"d\" must be a metric on \"s\"+ -- (<https://en.wikipedia.org/wiki/Metric_space#Definition>):+ --+ -- * d x y >= 0+ --+ -- * d x y == 0 iff x == y+ --+ -- * d x y == d y x+ --+ -- * d x z <= d x y + d y z+ -> BKTree s+empty = BKTree EmptyBK++insert :: s -> BKTree s -> BKTree s+insert s (BKTree bk f) = BKTree (insert' s f bk) f++insert' :: s -> Distance s -> BK s -> BK s+insert' s _ EmptyBK = BK s IntMap.empty+insert' s f bk@(BK s' bks)+ | dist == 0 = bk+ | otherwise = BK s' $ flip (IntMap.insert dist) bks $+ maybe (insert' s f EmptyBK) (insert' s f) (IntMap.lookup dist bks)+ where dist = f s s'++query :: Int -- ^ The maximum distance to search for.+ -> s -> BKTree s+ -> [(s, Int)] -- ^ All the words with a distance less than the+ -- one specified, and their respective+ -- distances.+query maxd s (BKTree bk f) = query' maxd s f bk++query' :: Int -> s -> Distance s -> BK s -> [(s, Int)]+query' _ _ _ EmptyBK = []+query' maxd s f (BK s' bks) = match ++ concatMap (query' maxd s f) children+ where+ dist = f s s'+ match = if (dist <= maxd) then [(s', dist)] else []+ children = IntMap.elems $ narrow (max (dist - maxd) 0) (dist + maxd) bks
Language/Distance/Search/BK.hs view
@@ -6,8 +6,7 @@ -- <https://en.wikipedia.org/wiki/Bk-tree>. It performs reasonably, and it -- scales decently as the query distance increases. Moreover the data -- structure can work on any instance of 'EditDistance', or in fact any metric--- space (although no interface for that purpose is defined):--- <https://en.wikipedia.org/wiki/Metric_space>.+-- space - a generic interface is provided in 'Data.BKTree'. -- -- However, for very short distances (less than 3), -- 'Language.Distance.Search.TST' is faster.@@ -22,47 +21,27 @@ , damerauLevenshtein ) where -import Data.IntMap (IntMap)-import qualified Data.IntMap as IntMap+import Control.Arrow (second) import Data.ListLike (ListLike) +import qualified Data.BKTree as BKTree import Language.Distance (EditDistance (..), Levenshtein, DamerauLevenshtein) import Language.Distance.Internal -data BKTree full algo- = EmptyBK- | BKTree !full !(IntMap (BKTree full algo))--narrow :: Int -> Int -> IntMap a -> IntMap a-narrow n m im | n == m = IntMap.fromList (maybe [] (\v -> [(n, v)]) (IntMap.lookup n im))-narrow n m im | otherwise = insMaybe m res pr- where- (_, pl, res0) = IntMap.splitLookup n im- (res, pr, _) = IntMap.splitLookup m (insMaybe n res0 pl)- insMaybe k im' = maybe im' (\v -> IntMap.insert k v im')+newtype BKTree full algo = BKTree (BKTree.BKTree full) -empty :: BKTree full algo-empty = EmptyBK+empty :: forall full sym algo. (EditDistance sym algo, ListLike full sym)+ => BKTree full algo+empty = BKTree (BKTree.empty (\s s' -> getDistance (distance s s' :: Distance algo))) -insert :: forall full sym algo. (Eq sym, EditDistance sym algo, ListLike full sym)+insert :: (EditDistance sym algo, ListLike full sym) => full -> BKTree full algo -> BKTree full algo-insert str EmptyBK = BKTree str IntMap.empty-insert str bk@(BKTree str' bks)- | dist == 0 = bk- | otherwise = BKTree str' $ flip (IntMap.insert dist) bks $- maybe (insert str EmptyBK) (insert str) (IntMap.lookup dist bks)- where dist = getDistance (distance str str' :: Distance algo)+insert s (BKTree bk) = BKTree (BKTree.insert s bk) -query :: forall full sym algo. (ListLike full sym, EditDistance sym algo)+query :: (ListLike full sym, EditDistance sym algo) => Int -> full -> BKTree full algo -> [(full, Distance algo)]-query _ _ EmptyBK = []-query maxd str (BKTree str' bks) = match ++ concatMap (query maxd str) children- where- dist = distance str str' :: Distance algo- intDist = getDistance dist- match = if (intDist <= maxd) then [(str', dist)] else []- children = IntMap.elems $ narrow (max (intDist - maxd) 0) (intDist + maxd) bks+query maxd s (BKTree bk) = map (second Distance) $ BKTree.query maxd s bk levenshtein :: (ListLike full sym, EditDistance sym Levenshtein) => Int -> full -> BKTree full Levenshtein -> [(full, Distance Levenshtein)]
language-spelling.cabal view
@@ -1,6 +1,6 @@ Cabal-Version: >= 1.8 Name: language-spelling-Version: 0.1.2+Version: 0.2 Author: Francesco Mazzoli (f@mazzo.li) Maintainer: Francesco Mazzoli (f@mazzo.li) Build-Type: Simple@@ -55,15 +55,16 @@ Exposed-Modules: Language.Distance, Language.Distance.Internal, Language.Distance.Search,- Language.Distance.Search.Class, Language.Distance.Search.BK, Language.Distance.Search.TST, Language.Phonetic, Language.Phonetic.Internal,+ Data.BKTree, Data.TST, Data.TSTSet - Other-Modules: Language.Phonetic.Soundex,+ Other-Modules: Language.Distance.Search.Class,+ Language.Phonetic.Soundex, Language.Phonetic.Encoder Test-Suite benchmarks