bktrees 0.2.1 → 0.2.2
raw patch · 3 files changed
+100/−87 lines, 3 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- Data/Set/BKTree.hs +77/−84
- README +19/−0
- bktrees.cabal +4/−3
Data/Set/BKTree.hs view
@@ -215,24 +215,7 @@ -- | Constructs a tree from a list fromList :: Metric a => [a] -> BKTree a-fromList xs = constructTree (\a -> Just (a,[])) xs--constructTree extract [] = Empty-constructTree extract (a:as)- = case extract a of- Nothing -> constructTree extract as- Just (piv,rest) -> - (\imap -> Node piv (1 + sum (map size (M.elems imap))) imap) $- M.fromAscList $- map recurse $- L.groupBy ((==) `on` fst) $- L.sortBy (compare `on` fst) $- concatMap (mkDist piv) $- as ++ rest- where mkDist piv m = case extract m of- Just (a,_) -> [(distance piv a,m)]- Nothing -> []- recurse bs@((k,_):_) = (k, constructTree extract (map snd bs))+fromList xs = L.foldl' (flip insert) empty xs -- | Merges several trees unions :: Metric a => [BKTree a] -> BKTree a@@ -249,7 +232,7 @@ closest a tree@(Node b _ _) = Just (closeLoop a (b,distance a b) tree) closeLoop a candidate Empty = candidate-closeLoop a candidate@(b,d) (Node x _ imap)+closeLoop a candidate@(_,d) (Node x _ imap) = L.foldl' (closeLoop a) newCand (M.elems subMap) where newCand = if j >= d then candidate@@ -268,41 +251,40 @@ -- Testing -- N.B. This code requires QuickCheck 2.0 +{- Testing using algebraic specification. The idea is that we have this+naive inefficient distance function. But instead of comparing it to our actual+implementation we take each clause in the definition and make it into an +equation. We also change each occurrence of the name naive to a call to the+distance function. --- We use a more standard implementation of the levenshtein edit distance--- to check the hirschberg algorithm-levenshtein :: Eq a => [a] -> [a] -> Int-levenshtein xs ys = let- lxs = length xs- lys = length ys- d x y cx cy = minimum- [dist!(x-1,y-1) + (if cx == cy then 0 else 1)- ,dist!(x-1,y) + 1- ,dist!(x,y-1) + 1- ]- dist :: Array (Int,Int) Int- dist = array ((0,0),(lxs,lys))- ( [((0,0),0)]- ++ [((x,0),x) | x <- [1..lxs]]- ++ [((0,y),y) | y <- [1..lys]]- ++ [ ((x,y),d x y cx cy)- | (x,cx) <- zip [1..] xs- , (y,cy) <- zip [1..] ys])- in dist!(lxs,lys)+naive [] ys = length ys+naive xs [] = length xs+naive (x:xs) (y:ys) | x == y = naive xs ys+naive (x:xs) (y:ys) = 1 + minimum [naive (x:xs) ys+ ,naive (x:xs) (x:ys)+ ,naive xs (y:ys)] --- These properties are all rather weaker than I would like. --- Think of something better.-prop_levenshtein xs ys = distance xs ys == levenshtein xs (ys :: [Int])+For example, the third clause becomes:+distance (x:xs) (x:ys) == distance xs ys -prop_levenshteinRepeat (NonZero (NonNegative n)) (NonZero (NonNegative m)) = - distance (replicate n (0::Int)) (replicate m 0) == distance n m+That way we can construct a quickCheck property from it. So, one property for+each equation in the naive algorithm. Pretty sweet! Credits go to Koen.+-} -prop_levenshteinLength xs =- forAll (vectorOf (length xs) arbitrary) $ \ys -> - distance xs ys == length xs && allDifferent xs ys- || distance xs ys < length (xs :: [Int])- where allDifferent xs ys = all (==False) (zipWith (==) xs ys)+-- Way too inefficient!+-- prop_naive xs ys = distance xs ys == naive xs (ys :: [Int]) +prop_naiveEmpty xs = + distance [] xs == length xs &&+ distance xs [] == length (xs::[Int])+prop_naiveCons x xs ys = distance (x:xs) (x:ys) == distance xs (ys::[Int])+prop_naiveDiff x y xs ys = x /= y ==>+ distance (x:xs) (y:ys) ==+ 1 + minimum [distance (x:xs) (ys :: [Int])+ ,distance (x:xs) (x:ys)+ ,distance xs (y:ys)]++-- ---------------------------------------------------- -- Semantics of BKTrees. Just a boring list of integers sem tree = L.sort (elems tree) :: [Int] @@ -374,7 +356,13 @@ prop_unionInv xs ys = invariant (union (fromList (xs :: [Int])) (fromList (ys :: [Int]))) +-- Error case : 0 [1073741824,0]+-- QuickCheck 2.1 finds this easily. +-- The above error case hit the limit of Int. +-- Maybe I should use Integer after all? prop_closest n xs =+ -- Some arbitrary level so that we don't hit the limit of Int+ all (\x -> abs x < 100000) xs ==> case (closest n (fromList xs),xs) of (Nothing,[]) -> True (Just (_,d),ys) -> d == minimum (map (distance n) (ys::[Int]))@@ -413,42 +401,47 @@ -- All the tests -tests = [("empty", quickCheck' prop_empty)- ,("null", quickCheck' prop_null)- ,("singleton", quickCheck' prop_singleton)- ,("fromList", quickCheck' prop_fromList)- ,("fromList inv", quickCheck' prop_fromListInv)- ,("insert", quickCheck' prop_insert)- ,("insert inv", quickCheck' prop_insertInv)- ,("member", quickCheck' prop_member)- ,("memberDistance", quickCheck' prop_memberDistance)- ,("delete", quickCheck' prop_delete)- ,("delete inv", quickCheck' prop_deleteInv)- ,("elems", quickCheck' prop_elems)- ,("elemsDistance", quickCheck' prop_elemsDistance)- ,("unions", quickCheck' prop_unions)- ,("unions inv", quickCheck' prop_unionsInv)- ,("union", quickCheck' prop_union)- ,("union inv", quickCheck' prop_unionInv)- ,("closest", quickCheck' prop_closest)- ,("size/empty", quickCheck' prop_sizeEmpty)- ,("size/fromList", quickCheck' prop_sizeFromList)- ,("size/succ", quickCheck' prop_sizeSucc)- ,("size/delete", quickCheck' prop_sizeDelete)- ,("size/union", quickCheck' prop_sizeUnion)- ,("size/unions", quickCheck' prop_sizeUnions)- ,("insert/delete", quickCheck' prop_insertDelete)- ,("fromList/member", quickCheck' prop_fromListMember)- ,("unions/member", quickCheck' prop_unionsMember)- ,("levenshtein", quickCheck' prop_levenshtein)- ,("levenshtein repeat",quickCheck' prop_levenshteinRepeat)- ,("levenshtein length",quickCheck' prop_levenshteinLength)+data TestCase = forall prop. Testable prop => Tc String prop++tests = [Tc "empty" prop_empty+ ,Tc "null" prop_null+ ,Tc "singleton" prop_singleton+ ,Tc "fromList" prop_fromList+ ,Tc "fromList inv" prop_fromListInv+ ,Tc "insert" prop_insert+ ,Tc "insert inv" prop_insertInv+ ,Tc "member" prop_member+ ,Tc "memberDistance" prop_memberDistance+ ,Tc "delete" prop_delete+ ,Tc "delete inv" prop_deleteInv+ ,Tc "elems" prop_elems+ ,Tc "elemsDistance" prop_elemsDistance+ ,Tc "unions" prop_unions+ ,Tc "unions inv" prop_unionsInv+ ,Tc "union" prop_union+ ,Tc "union inv" prop_unionInv+ ,Tc "closest" prop_closest+ ,Tc "size/empty" prop_sizeEmpty+ ,Tc "size/fromList" prop_sizeFromList+ ,Tc "size/succ" prop_sizeSucc+ ,Tc "size/delete" prop_sizeDelete+ ,Tc "size/union" prop_sizeUnion+ ,Tc "size/unions" prop_sizeUnions+ ,Tc "insert/delete" prop_insertDelete+ ,Tc "fromList/member" prop_fromListMember+ ,Tc "unions/member" prop_unionsMember+ ,Tc "naiveEmpty" prop_naiveEmpty+ ,Tc "naiveCons" prop_naiveCons+ ,Tc "naiveDiff" prop_naiveDiff ] runTests = mapM_ runTest tests- where runTest (s,a) = do printf "%-25s :" s- b <- a- if b - then return ()- else exitFailure+ where runTest (Tc s prop) + = do printf "%-25s :" s+ result <- quickCheckResult prop+ case result of+ Success _ -> return ()+ GaveUp _ _ -> return ()+ _ -> exitFailure+ #endif
+ README view
@@ -0,0 +1,19 @@+This is a module I hacked together quickly after having read the following+blog post:+http://blog.notdot.net/archives/30-Damn-Cool-Algorithms,-Part-1-BK-Trees.html++I thought the data structure sounded cool so I thought it would be an +interesting excerise to implement it. ++BK-trees can apparently perform very good in some circumstances. The +paper "Fast Approximate String Matching in a Dictionary" (Baeza-Yates, +Navarro 1998) recommends them over other structures for doing +approximate search.+http://citeseer.ist.psu.edu/1593.html++The original paper can be found here:+http://portal.acm.org/citation.cfm?id=362003.362025++Henning Günter <h.guenther@tu-bs.de> generously supplied two algorithms for+computing the levenshtein edit distance. The better one of the two is used in+the list instance for the Metric class.
bktrees.cabal view
@@ -1,5 +1,5 @@ name: bktrees-version: 0.2.1+version: 0.2.2 license: BSD3 license-file: LICENSE author: Josef Svenningsson@@ -14,16 +14,17 @@ you are searching for. cabal-version: >=1.2 extra-source-files: test/Test.hs+extra-source-files: README+build-type: Simple flag splitBase description: Choose the new smaller, split-up base package. library if flag(splitBase)- build-depends: base >= 3, containers, array+ build-depends: base >= 3, base < 4, containers, array else build-depends: base < 3 exposed-modules: Data.Set.BKTree extensions: CPP- ghc-options: -O