bk-tree (empty) → 0.1

raw patch · 3 files changed

+98/−0 lines, 3 filesdep +basedep +containerssetup-changed

Dependencies added: base, containers

Files

• Data/BKTree.hs +69/−0
• Setup.hs +2/−0
• bk-tree.cabal +27/−0

@@ -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

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,27 @@+Cabal-Version:      >= 1.8+Name:               bk-tree+Version:            0.1+Author:             Francesco Mazzoli (f@mazzo.li)+Maintainer:         Francesco Mazzoli (f@mazzo.li)+Build-Type:         Simple+License:            PublicDomain+Build-Type:         Simple+Category:           Data Structures+Synopsis:           BK-tree implementation+Tested-With:        GHC==7.4.1+Homepage:           https://github.com/bitonic/language-spelling+Bug-Reports:        https://github.com/bitonic/language-spelling/issues+Description:+    BK-tree implementation.++source-repository head+    type:     git+    location: git://github.com/bitonic/language-spelling.git++Library+    Build-Depends:    base >= 3 && < 5,+                      containers++    GHC-Options:      -Werror -O2++    Exposed-Modules:  Data.BKTree