text: {- | Module : Data.Set.BKTree Copyright : (c) Josef Svenningsson 2007 (c) Henning Günter 2007 License : BSD-style Maintainer : josef.svenningsson@gmail.com Stability : Alpha quality. Interface may change without notice. Portability : portable Bur a undirected graph and the Hamming distance between two binary strings. Any euclidean space also has a metric. However, in this module we use int-valued metrics and that doesn't quite. -} -- -------- -- | The type of Burhard-Keller trees. data BKTree a = Node a (M.IntMap (BKTree a)) | Empty #ifdef DEBUG deriving Show #endif -- | -- N.B. This code requires QuickCheck 2.0 -- 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) -- 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]) prop_levenshteinRepeat (NonZero (NonNegative n)) (NonZero (NonNegative m)) = distance (replicate n (0::Int)) (replicate m 0) == distance n m 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) --) ,("levenshtein", quickCheck' prop_levenshtein) ,("levenshtein repeat",quickCheck' prop_levenshteinRepeat) ,("levenshtein length",quickCheck' prop_levenshteinLength) ] runTests = mapM_ runTest tests where runTest (s,a) = do printf "%-25s :" s b <- a if b then return () else exitFailure #endif