Took the JVM branch example programs

datastruct/tree/trie/src/EDict.hs

@@ -20,10 +20,9 @@ module Main where
 
 import qualified Data.List
 import qualified Trie
-import Patricia
 
 -- find all candidates in Trie
-findAll:: Trie.Trie a -> String -> [(String, a)]
+findAll:: Trie.Trie Char v -> String -> [(String, v)]
 findAll t [] =
     case Trie.value t of
       Nothing -> enum (Trie.children t)
@@ -36,30 +35,8 @@ findAll t (k:ks) =
       Nothing -> []
       Just t' -> mapAppend k (findAll t' ks)
 
-mapAppend x lst = map (\p->(x:(fst p), snd p)) lst
+mapAppend x = map (\p->(x:(fst p), snd p))
 
--- find all candidates in Patricia
-findAll' :: Patricia a -> Key -> [(Key, a)]
-findAll' t [] =
-    case value t of
-      Nothing -> enum $ children t
-      Just x  -> ("", x):(enum $ children t)
-    where
-      enum [] = []
-      enum (p:ps) = (mapAppend' (fst p) (findAll' (snd p) [])) ++ (enum ps)
-findAll' t k = find' (children t) k where
-    find' [] _ = []
-    find' (p:ps) k
-          | (fst p) == k
-              = mapAppend' k (findAll' (snd p) [])
-          | (fst p) `Data.List.isPrefixOf` k
-              = mapAppend' (fst p) (findAll' (snd p) (k `diff` (fst p)))
-          | k `Data.List.isPrefixOf` (fst p)
-              = findAll' (snd p) []
-          | otherwise = find' ps k
-    diff x y = drop (length y) x
-
-mapAppend' s lst = map (\p->(s++(fst p), snd p)) lst
 
 -- T9 mapping
 mapT9 = [('2', "abc"), ('3', "def"), ('4', "ghi"), ('5', "jkl"),
@@ -74,36 +51,20 @@ lookupT9 c children = case lookup c mapT9 of
                  Just t  -> (x, t):lst
 
 -- T9-find in Trie
-findT9:: Trie.Trie a -> String -> [(String, Maybe a)]
+findT9:: Trie.Trie Char v -> String -> [(String, Maybe v)]
 findT9 t [] = [("", Trie.value t)]
 findT9 t (k:ks) = foldl f [] (lookupT9 k (Trie.children t))
     where
       f lst (c, tr) = (mapAppend c (findT9 tr ks)) ++ lst
 
--- T9-find in Patricia
-findPrefixT9' :: String -> [(String, b)] -> [(String, b)]
-findPrefixT9' s lst = filter f lst where
-    f (k, _) = (toT9 k) `Data.List.isPrefixOf` s
-
 toT9 = map (\c -> head $ [ d |(d, s) <- mapT9, c `elem` s])
 
-findT9' :: Patricia a -> String -> [(String, Maybe a)]
-findT9' t [] = [("", value t)]
-findT9' t k = foldl f [] (findPrefixT9' k (children t))
-    where
-      f lst (s, tr) = (mapAppend' s (findT9' tr (k `diff` s))) ++ lst
-      diff x y = drop (length y) x
-
 -- test
-testFindAll = "t=" ++ (Trie.toString t) ++
+testFindAll = "t=" ++ (show t) ++
               "\nlook up a: " ++ (show $ take 5 $findAll t "a") ++
-              "\nlook up ab: " ++ (show $ take 5 $findAll t "ab") ++ "\n\n" ++
-              "t'=" ++ (toString t') ++
-              "\nlook up a: " ++ (show $ take 5 $findAll' t' "a") ++
-              "\nlook up ab: " ++ (show $ take 5 $findAll' t' "ab")
+              "\nlook up ab: " ++ (show $ take 5 $findAll t "ab") ++ "\n\n"
     where
       t = Trie.fromList lst
-      t'= fromList lst
       lst=[("a", "the first letter of English"),
            ("an", "used instead of 'a' when the following word begins with a vowel sound"),
            ("another", "one more person or thing or an extra amount"),
@@ -114,23 +75,14 @@ testFindAll = "t=" ++ (Trie.toString t) ++
            ("bodyl", "the whole physical structure that forms a person or animal"),
            ("zoo", "an area in which animals, especially wild animals, are kept so that people can go and look at them, or study them")]
 
-testFindT9 = "t=" ++ (Trie.toString t) ++
+testFindT9 = "t=" ++ (show t) ++
              "\npress 4: " ++ (show $ take 5 $ findT9 t "4")++
              "\npress 46: " ++ (show $ take 5 $ findT9 t "46")++
              "\npress 4663: " ++ (show $ take 5 $ findT9 t "4663")++
              "\npress 2: " ++ (show $ take 5 $ findT9 t "2")++
-             "\npress 22: " ++ (show $ take 5 $ findT9 t "22")++
-             "\n\nt'=" ++ (toString t') ++
-             "\npress 4: " ++ (show $ take 5 $ findT9' t' "4")++
-             "\npress 46: " ++ (show $ take 5 $ findT9' t' "46")++
-             "\npress 466: " ++ (show $ take 5 $ findT9' t' "466")++
-             "\npress 4663: " ++ (show $ take 5 $ findT9' t' "4663")++
-             "\npress 2: " ++ (show $ take 5 $ findT9' t' "2")++
-             "\npress 22: " ++ (show $ take 5 $ findT9' t' "22")
-
+             "\npress 22: " ++ (show $ take 5 $ findT9 t "22")
     where
       t = Trie.fromList lst
-      t' = fromList lst
       lst = [("home", 1), ("good", 2), ("gone", 3), ("hood", 4), ("a", 5), ("another", 6), ("an", 7)]
 
 main = do

datastruct/tree/trie/src/IntPatricia.hs

@@ -1,5 +1,5 @@
 {-
-    IntPatricia.hs, Integer base Patricia Tree.
+    IntPatricia.hs, Integer base prefix tree.
     Copyright (C) 2010, Liu Xinyu ([email protected])
 
     This program is free software: you can redistribute it and/or modify
@@ -16,7 +16,7 @@
     along with this program.  If not, see <http://www.gnu.org/licenses/>.
 -}
 
--- Int (as key) Patricia Tree
+-- Int (as key) Prefix Tree
 -- Referred from Haskell packages Data.IntMap
 -- Other reference includes:
 --  [1] CLRS, Problems 12-2: Radix trees
@@ -27,11 +27,13 @@
 module IntPatricia where
 
 import Data.Bits
+import Test.QuickCheck hiding ((.&.))
+import Data.Maybe (isNothing)
 
-{------------------------------------ 
-  1. Big Edian Patricia tree
+{------------------------------------
+  1. Big Edian integer tree
 -------------------------------------}
-data IntTree a = Empty 
+data IntTree a = Empty
                | Leaf Key a
                | Branch Prefix Mask (IntTree a) (IntTree a) -- prefix, mask, left, right
 
@@ -51,11 +53,11 @@ type Mask = Int
 --         prefix  = a(n),a(n-1),...a(i+1),a(i),00...0
 --  2. mask bit = 100...0b (=2^i)
 --         so mask is something like, 1,2,4,...,128,256,...
---  3. if      x=='0', y=='1' then (tree1=>left, tree2=>right), 
+--  3. if      x=='0', y=='1' then (tree1=>left, tree2=>right),
 --     else if x=='1', y=='0' then (tree2=>left, tree1=>right).
 join :: Prefix -> IntTree a -> Prefix -> IntTree a -> IntTree a
 join p1 t1 p2 t2 = if zero p1 m then Branch p m t1 t2
-                                else Branch p m t2 t1 
+                                else Branch p m t2 t1
     where
       (p, m) = lcp p1 p2
 
@@ -98,11 +100,11 @@ match k p m = (mask k m) == p
   3. Insertion
 --------------------------------------}
 
--- if user insert a value already binding with existed key, 
+-- if user insert a value already binding with existed key,
 -- just over write the previous value
 -- usage: insert tree key x
 insert :: IntTree a -> Key -> a -> IntTree a
-insert t k x 
+insert t k x
    = case t of
        Empty -> Leaf k x
        Leaf k' x' -> if k==k' then Leaf k x
@@ -119,11 +121,11 @@ insert t k x
 
 -- look up a key
 search :: IntTree a -> Key -> Maybe a
-search t k 
+search t k
   = case t of
       Empty -> Nothing
       Leaf k' x -> if k==k' then Just x else Nothing
-      Branch p m l r 
+      Branch p m l r
              | match k p m -> if zero k m then search l k
                               else search r k
              | otherwise -> Nothing
@@ -132,7 +134,7 @@ search t k
   5. Test helper
 ---------------------------------}
 
--- Generate a Int Patricia tree from a list
+-- Generate a Int tree from a list
 -- Usage: fromList [(k1, x1), (k2, x2),..., (kn, xn)]
 fromList :: [(Key, a)] -> IntTree a
 fromList xs = foldl ins Empty xs where
@@ -143,7 +145,7 @@ toString t =
     case t of
       Empty -> "."
       Leaf k x -> (show k) ++ ":" ++ (show x)
-      Branch p m l r -> "[" ++ (show p) ++ "@" ++ (show m) ++ "]" ++ 
+      Branch p m l r -> "[" ++ (show p) ++ "@" ++ (show m) ++ "]" ++
                         "(" ++ (toString l) ++ ", " ++ (toString r) ++ ")"
 
 {---------------------------------
@@ -154,3 +156,18 @@ testIntTree = "t=" ++ (toString t) ++ "\nsearch t 4: " ++ (show $ search t 4) ++
     where
       t = fromList [(1, 'x'), (4, 'y'), (5, 'z')]
 
+-- Verification
+
+data Sample = S [(Key, Int)] [Int] deriving Show
+
+instance Arbitrary Sample where
+  arbitrary = do
+    n <- choose (2, 100)
+    xs <- shuffle [0..100]
+    let (ks, ks') = splitAt n xs
+    return $ S (zip ks [1..]) ks'
+
+prop_build :: Sample -> Bool
+prop_build (S kvs ks') = let t = fromList kvs in
+  (all (\(k, v) -> Just v == search t k) kvs ) &&
+  (all (isNothing . search t) ks')

datastruct/tree/trie/src/IntTrie.hs

@@ -27,12 +27,16 @@
 -- A very simple int (binary) trie as CLRS 12-2 (Little-Edian)
 module IntTrie where
 
-data IntTrie a = Empty 
+import Test.QuickCheck
+import Data.Maybe (isNothing)
+
+data IntTrie a = Empty
                | Branch (IntTrie a) (Maybe a) (IntTrie a) -- left, value, right
+               deriving Show
 
 type Key = Int
 
--- helpers
+-- accessors
 left :: IntTrie a -> IntTrie a
 left (Branch l _ _) = l
 left Empty = Empty
@@ -46,7 +50,7 @@ value (Branch _ v _) = v
 value Empty = Nothing
 
 -- Insertion
--- if user insert a value already binding with existed key, just over write 
+-- if user insert a value already binding with existed key, just over write
 -- the previous value
 -- usage: insert trie key x
 insert :: IntTrie a -> Key -> a -> IntTrie a
@@ -62,24 +66,37 @@ search t 0 = value t
 search t k = if even k then search (left t) (k `div` 2)
              else search (right t) (k `div` 2)
 
--- Test helper
 fromList :: [(Key, a)] -> IntTrie a
 fromList xs = foldl ins Empty xs where
     ins t (k, v) = insert t k v
 
 -- k = ... a2, a1, a0 ==> k' = ai * m + k, where m=2^i
-toString :: (Show a)=>IntTrie a -> String
-toString t = toStr t 0 1 where
-    toStr Empty k m = "."
-    toStr tr k m = "(" ++ (toStr (left tr) k (2*m)) ++
-                      " " ++ (show k) ++ (valueStr (value tr)) ++
-                      " " ++ (toStr (right tr) (m+k) (2*m)) ++ ")"
-    valueStr (Just x) = ":" ++ (show x)
-    valueStr _ = ""
-
--- Test cases
-testIntTrie = "t=" ++ (toString t) ++ "\nsearch t 4: " ++ (show $ search t 4) ++
-              "\nsearch t 0: " ++ (show $ search t 0)
-    where
-      t = fromList [(1, 'a'), (4, 'b'), (5, 'c'), (9, 'd')]
-
+toList :: IntTrie a -> [(Key, Maybe a)]
+toList = toList' 0 1 where
+  toList' _ _ Empty = []
+  toList' k m (Branch l v r) = (toList' k (2 * m) l) ++
+    ((k, v) : (toList' (m + k) (2 * m) r))
+
+-- Verification
+
+data Sample = S [(Key, Int)] [Int] deriving Show
+
+instance Arbitrary Sample where
+  arbitrary = do
+    n <- choose (2, 100)
+    xs <- shuffle [0..100]
+    let (ks, ks') = splitAt n xs
+    return $ S (zip ks [1..]) ks'
+
+prop_build :: Sample -> Bool
+prop_build (S kvs ks') = let t = fromList kvs in
+  (all (\(k, v) -> Just v == search t k) kvs ) &&
+  (all (isNothing . search t) ks')
+
+example = do
+  let t = fromList [(1, 'a'), (4, 'b'), (5, 'c'), (9, 'd')]
+  putStrLn $ show $ toList t
+  putStrLn "search t 4"
+  putStrLn $ show $ search t 4
+  putStrLn "search t 0"
+  putStrLn $ show $ search t 0