diff --git a/Data/Map/TernaryMap.hs b/Data/Map/TernaryMap.hs --- a/Data/Map/TernaryMap.hs +++ b/Data/Map/TernaryMap.hs @@ -1,6 +1,15 @@ -module Data.Map.TernaryMap where +module Data.Map.TernaryMap ( + TernaryMap, + insert, + singleton, + member, + size, + + ) where import Data.Binary import Control.Monad +import qualified Data.Set.TernarySet as S +import Prelude hiding (lookup) -- | Elem2 a b is used to hold elements of a list after insertion, and @@ -34,12 +43,12 @@ -- | Quickly build a tree without an initial tree. This should be used -- to create an initial tree, using insert there after. -insert' :: Ord a => [a] -> b -> TernaryMap a b -insert' (x:xs) b = TNode (C x) TEnd (insert' xs b) TEnd -insert' [] b = TNode (Val b) TEnd TEnd TEnd +singleton :: Ord a => [a] -> b -> TernaryMap a b +singleton (x:xs) b = TNode (C x) TEnd (singleton xs b) TEnd +singleton [] b = TNode (Val b) TEnd TEnd TEnd --- | Inserts an entries into a tree. Values with the same key will be replaced --- with the newer version. +-- | Inserts an entrie into a tree. Values with the same key will be replaced +-- with the newer value. insert :: Ord a => [a] -> b -> TernaryMap a b -> TernaryMap a b -- General case insert xss@(x:xs) b (TNode ele l e h) = @@ -49,7 +58,7 @@ GT -> TNode ele l e (insert xss b h) -- Insert new elements quickly insert xss@(x:xs) b TEnd = - insert' xss b + singleton xss b -- end of word in non empty tree insert [] b (TNode ele l e h) = case compare (Val b) ele of @@ -61,43 +70,73 @@ -- | Returns true if the `[a]` is a key in the TernaryMap. -isKey :: Ord a => [a] -> TernaryMap a b -> Bool -isKey _ TEnd = False -isKey [] (TNode ele l e h) = isVal ele || isKey [] l -isKey xss@(x:xs) (TNode ele l e h) = +member :: Ord a => [a] -> TernaryMap a b -> Bool +member _ TEnd = False +member [] (TNode ele l e h) = isVal ele || member [] l +member xss@(x:xs) (TNode ele l e h) = case compare (C x) ele of - LT -> isKey xss l - EQ -> isKey xs e - GT -> isKey xss h + LT -> member xss l + EQ -> member xs e + GT -> member xss h -getVal :: Ord a => [a] -> TernaryMap a b -> Maybe b -getVal _ TEnd = Nothing -getVal [] (TNode (Val b) _ _ _) = Just b -getVal [] (TNode ele l _ _) = getVal [] l -getVal xss@(x:xs) (TNode ele l e h) = +lookup :: Ord a => [a] -> TernaryMap a b -> Maybe b +lookup _ TEnd = Nothing +lookup [] (TNode (Val b) _ _ _) = Just b +lookup [] (TNode ele l _ _) = lookup [] l +lookup xss@(x:xs) (TNode ele l e h) = case compare (C x) ele of - LT -> getVal xss l - EQ -> getVal xs e - GT -> getVal xss h + LT -> lookup xss l + EQ -> lookup xs e + GT -> lookup xss h +(!) :: Ord a => TernaryMap a b -> [a] -> Maybe b +(!) = flip lookup --- | Returns the number of non-Val Elems +-- | Returns the number of non-Val Elems. not exported treeSize :: TernaryMap a b -> Int treeSize TEnd = 0 treeSize (TNode (Val _) l e h) = treeSize l + treeSize e + treeSize h treeSize (TNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h -- | Counts how many entries there are in the tree. -numEntries :: TernaryMap a b -> Int -numEntries TEnd = 0 -numEntries (TNode (Val _) l e h) = 1 + numEntries l + numEntries e + numEntries h -numEntries (TNode _ l e h) = numEntries l + numEntries e + numEntries h +size :: TernaryMap a b -> Int +size TEnd = 0 +size (TNode (Val _) l _ h) = 1 + size l + size h +size (TNode _ l e h) = size l + size e + size h -- | Creates a new tree from a list of 'strings' fromList :: Ord a => [([a],b)] -> TernaryMap a b fromList = foldl (\tree (as,b) -> insert as b tree) TEnd +-- | An empty map. +empty :: TernaryMap a b +empty = TEnd + +-- | Makes a list of all the values in the map. +elems :: TernaryMap a b -> [b] +elems (TEnd) = [] +elems (TNode (Val v) l _ h) = elems l ++ (v : elems h) +elems (TNode _ l e h) = elems l ++ (elems e ++ elems h) + +-- | Returns true if the map is empty. +null :: TernaryMap a b -> Bool +null TEnd = True +null _ = False + +-- keySet :: TernaryMap a b -> S.TernarySet a +-- keySet TEnd = S.TEnd +-- keySet (TNode (C x) l e h) = S.TNode (S.C x) (keySet l) (keySet e) (keySet h) +-- keySet (TNode (Val _) l e h) = S.TNode (S.Null) (keySet l) (keySet e) (keySet h) + +instance Functor (Elem2 a) where + fmap _ (C x) = C x + fmap f (Val b) = Val . f $ b + +instance Functor (TernaryMap a) where + fmap f (TNode ele l e h) = TNode (fmap f ele) (fmap f l) (fmap f e) (fmap f h) + fmap _ TEnd = TEnd + instance (Binary a, Binary b) => Binary (Elem2 a b) where - put (C x) = putWord8 0 >> put x + put (C a) = putWord8 0 >> put a put (Val b) = putWord8 1 >> put b get = do n <- getWord8 @@ -105,8 +144,8 @@ 0 -> liftM C get 1 -> liftM Val get --- | This binary instance saves some space by making special cases --- of some commonly encountered structures in the trees. +-- | A rather long Binary instance, that uses binary numbers to indicate +-- where TEnds are efficiently. instance (Binary a, Binary b) => Binary (TernaryMap a b) where put (TNode ch TEnd TEnd TEnd) = do putWord8 0 diff --git a/Data/Set/StringSet.hs b/Data/Set/StringSet.hs --- a/Data/Set/StringSet.hs +++ b/Data/Set/StringSet.hs @@ -1,10 +1,18 @@ -module Data.Set.StringSet where +module Data.Set.StringSet ( + StringSet, + insert, + singleton, + member, + size, + fromList + ) where import Data.Binary import Control.Monad -- | StringSet is ternary tree. It is commonly used for storing word lists -- like dictionaries for spell checking etc. -data StringSet = SNode !Char !StringSet !StringSet !StringSet | SEnd +data StringSet = SNode {-# UNPACK #-} !Char !StringSet !StringSet !StringSet + | SEnd deriving (Show, Eq) -- | Inserts a new list of elements into a tree. @@ -17,7 +25,7 @@ GT -> SNode ele l e (insert xss h) -- Insert new elements quickly insert xss@(x:xs) SEnd = - insert' xss + singleton xss -- SEnd of word in non empty tree insert [] t@(SNode ele l e h) = case compare '\0' ele of @@ -28,19 +36,19 @@ SNode '\0' SEnd SEnd SEnd -- | Quickly build an initial tree. -insert' :: String -> StringSet -insert' (x:xs) = SNode x SEnd (insert' xs) SEnd -insert' [] = SNode '\0' SEnd SEnd SEnd +singleton :: String -> StringSet +singleton (x:xs) = SNode x SEnd (singleton xs) SEnd +singleton [] = SNode '\0' SEnd SEnd SEnd -- | Returns true if the string is in the StringSet -isElem :: String -> StringSet -> Bool -isElem _ SEnd = False -isElem [] (SNode ele l e h) = ele == '\0' || isElem [] l -isElem xss@(x:xs) (SNode ele l e h) = +member :: String -> StringSet -> Bool +member _ SEnd = False +member [] (SNode ele l e h) = ele == '\0' || member [] l +member xss@(x:xs) (SNode ele l e h) = case compare x ele of - LT -> isElem xss l - EQ -> isElem xs e - GT -> isElem xss h + LT -> member xss l + EQ -> member xs e + GT -> member xss h -- | Returns the number of non-Null Elems treeSize :: StringSet -> Int @@ -49,16 +57,25 @@ treeSize (SNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h -- | Counts how many entries there are in the tree. -numEntries :: StringSet -> Int -numEntries SEnd = 0 -numEntries (SNode '\0' l e h) = 1 + numEntries l + numEntries e + numEntries h -numEntries (SNode _ l e h) = numEntries l + numEntries e + numEntries h +size :: StringSet -> Int +size SEnd = 0 +size (SNode '\0' l e h) = 1 + size l + size e + size h +size (SNode _ l e h) = size l + size e + size h -- | Creates a new tree from a list of 'strings' fromList :: [String] -> StringSet fromList = foldl (flip insert) SEnd --- | A rather long Binary instance, but uses binary numbers to indicate +-- | An empty set. +empty :: StringSet +empty = SEnd + +-- | Returns true if the set is empty. +null :: StringSet -> Bool +null SEnd = True +null _ = False + +-- | A rather long Binary instance, that uses binary numbers to indicate -- where SEnds are efficiently. instance Binary StringSet where put (SNode ch SEnd SEnd SEnd) = do @@ -99,6 +116,7 @@ put e put h put SEnd = putWord8 8 + get = do tag <- getWord8 case tag of diff --git a/Data/Set/TernarySet.hs b/Data/Set/TernarySet.hs --- a/Data/Set/TernarySet.hs +++ b/Data/Set/TernarySet.hs @@ -1,4 +1,11 @@ -module Data.Set.TernarySet where +module Data.Set.TernarySet ( + TernarySet, + insert, + singleton, + member, + size, + Elem(..) + ) where import Data.Binary import Control.Monad @@ -24,9 +31,9 @@ -- | Quickly build a tree without an initial tree. This should be used -- to create an initial tree, using insert there after. -insert' :: Ord a => [a] -> TernarySet a -insert' (x:xs) = TNode (C x) TEnd (insert' xs) TEnd -insert' [] = TNode Null TEnd TEnd TEnd +singleton :: Ord a => [a] -> TernarySet a +singleton (x:xs) = TNode (C x) TEnd (singleton xs) TEnd +singleton [] = TNode Null TEnd TEnd TEnd -- | Inserts an entries into a tree. insert :: Ord a => [a] -> TernarySet a -> TernarySet a @@ -38,7 +45,7 @@ GT -> TNode ele l e (insert xss h) -- Insert new elements quickly insert xss@(x:xs) TEnd = - insert' xss + singleton xss -- TEnd of word in non empty tree insert [] t@(TNode ele l e h) = case compare Null ele of @@ -50,34 +57,44 @@ -- | Returns true if the `[a]` is in the TernarySet -isElem :: Ord a => [a] -> TernarySet a -> Bool -isElem _ TEnd = False -isElem [] (TNode ele l e h) = ele == Null || isElem [] l -isElem xss@(x:xs) (TNode ele l e h) = +member :: Ord a => [a] -> TernarySet a -> Bool +member _ TEnd = False +member [] (TNode ele l e h) = ele == Null || member [] l +member xss@(x:xs) (TNode ele l e h) = case compare (C x) ele of - LT -> isElem xss l - EQ -> isElem xs e - GT -> isElem xss h + LT -> member xss l + EQ -> member xs e + GT -> member xss h --- | Returns the number of non-Null Elems +-- | Returns the number of non-Null Elems. not exported treeSize :: TernarySet a -> Int treeSize TEnd = 0 treeSize (TNode Null l e h) = treeSize l + treeSize e + treeSize h treeSize (TNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h -- | Counts how many entries there are in the tree. -numEntries :: TernarySet a -> Int -numEntries TEnd = 0 -numEntries (TNode Null l e h) = 1 + numEntries l + numEntries e + numEntries h -numEntries (TNode _ l e h) = numEntries l + numEntries e + numEntries h +size :: TernarySet a -> Int +size TEnd = 0 +size (TNode Null l e h) = 1 + size h +size (TNode _ l e h) = size l + size e + size h -- | Creates a new tree from a list of 'strings' fromList :: Ord a => [[a]] -> TernarySet a fromList = foldl (flip insert) TEnd +-- | An empty set. +empty :: TernarySet a +empty = TEnd + +-- | Returns true if the set is empty. +null :: TernarySet a -> Bool +null TEnd = True +null _ = False + instance Binary a => Binary (Elem a) where put Null = putWord8 0 put (C x) = putWord8 1 >> put x + get = do n <- getWord8 case n of @@ -125,6 +142,7 @@ put e put h put TEnd = putWord8 8 + get = do tag <- getWord8 case tag of @@ -170,7 +188,7 @@ -- put (TNode ch TEnd TEnd TEnd) = do -- putWord8 1 -- put ch - -- -- Also common, basically what insert' produces. + -- -- Also common, basically what singleton produces. -- put (TNode ch TEnd e TEnd) = do -- putWord8 2 -- put ch diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -16,10 +16,10 @@ -- print . treeSize $ tree putStr "All input words are in dictionary: " - print . all (`isElem` tree) $ wds -- make sure all words are actually in the tree + print . all (`member` tree) $ wds -- make sure all words are actually in the tree putStr "Same number of words as input: " - print (numEntries tree == length wds) -- make sure the same number of words are in the tree + print (size tree == length wds) -- make sure the same number of words are in the tree putStr ("Writing " ++ newname ++ "... ") encodeFile newname tree -- write the tree to a file as "filename.bin" @@ -30,8 +30,8 @@ putStr "done.\nRead in data matches original: " print (tree == ntree) -- check the read in tree is the same as the one we wrote -- - -- putStrLn "\n-- Enter a word to see if it is in the dictionary (^C to exit):" - -- interact' (("-- " ++) . show . (`isElem` tree)) -- enter a word to see if it's in the tree + -- putStrLn "\n-- Enter a word to see if it is in the dictionary (^C to exit):" + -- interact' (("-- " ++) . show . (`isElem` tree)) -- enter a word to see if it's in the tree interact' :: (String -> String) -> IO () interact' f = do diff --git a/TernaryTrees.cabal b/TernaryTrees.cabal --- a/TernaryTrees.cabal +++ b/TernaryTrees.cabal @@ -1,5 +1,5 @@ Name: TernaryTrees -Version: 0.0.4.0 +Version: 0.1.0.0 Category: Data Structures Synopsis: Efficient pure ternary tree Sets and Maps Description: Ternary trees are an efficient structure often used for storing @@ -11,7 +11,7 @@ as a dictionary program for spell checking, and how it can be used to serialise data with Don Stewart's Data.Binary package. . - From my testing, using the /usr/shart/dict/words file on my system + From my testing, using the \/usr\/share\/dict\/words file on my system (over 230,000 words), inserting all words, checking they all exist in the tree, writing them to a binary file, reading them back in and checking the read in result is the same as the original takes @@ -20,9 +20,16 @@ . New in this version: . - * Made the Data.Binary instances much more efficient by using - binary numbers to represent the number of *End nodes. + * First major interface change since the first release... (less than + 24 hours ago). . + * Changed many function names to match those in Data.[Map,Set] to + provide a more familiar interface. + . + * Added a Functor instance for TernaryMap. + . + * Added `empty` and `null` functions to all types, and `elems` + to TernaryMap. . © 2009 by Alex Mason (). BSD3 license.