TernaryTrees 0.1.0.0 → 0.1.1.0
raw patch · 4 files changed
+154/−247 lines, 4 files
Files
- Data/Map/TernaryMap.hs +9/−31
- Data/Set/StringSet.hs +53/−79
- Data/Set/TernarySet.hs +86/−127
- TernaryTrees.cabal +6/−10
Data/Map/TernaryMap.hs view
@@ -6,6 +6,7 @@ size, ) where+import Data.Bits import Data.Binary import Control.Monad import qualified Data.Set.TernarySet as S@@ -185,37 +186,14 @@ put e put h put TEnd = putWord8 8+ get = do tag <- getWord8- case tag of- 8 -> return TEnd- _ -> do+ if tag < 8+ then do ch <- get- case tag of- 0 -> return (TNode ch TEnd TEnd TEnd)- 1 -> do- h <- get- return (TNode ch TEnd TEnd h)- 2 -> do- e <- get- return (TNode ch TEnd e TEnd)- 3 -> do- e <- get- h <- get- return (TNode ch TEnd e h)- 4 -> do- l <- get- return (TNode ch l TEnd TEnd)- 5 -> do- l <- get- h <- get- return (TNode ch l TEnd h)- 6 -> do- l <- get- e <- get- return (TNode ch l e TEnd)- 7 -> do- l <- get- e <- get- h <- get- return (TNode ch l e h)+ l <- if (tag `testBit` 2) then get else return TEnd+ e <- if (tag `testBit` 1) then get else return TEnd+ h <- if (tag `testBit` 0) then get else return TEnd+ return (TNode ch l e h)+ else return TEnd
Data/Set/StringSet.hs view
@@ -6,45 +6,43 @@ size, fromList ) where+import Data.Bits 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 {-# UNPACK #-} !Char !StringSet !StringSet !StringSet- | SEnd+data StringSet = Node {-# UNPACK #-} !Char !StringSet !StringSet !StringSet -- | Tree node + | Null !StringSet -- | null nodes can only have a greater than branch by definition+ | End -- | a branch that doesn’t contain anything deriving (Show, Eq) -- | Inserts a new list of elements into a tree. insert :: String -> StringSet -> StringSet--- General case-insert xss@(x:xs) (SNode ele l e h) =+insert xss@(_:_) End = singleton xss+insert xss@(_:_) (Null rest) = Null $ insert xss rest+insert [] End = Null End+insert [] (Node ele l e h) = Node ele (insert [] l) e h+insert [] (Null rest) = Null rest+insert xss@(x:xs) (Node ele l e h) = case compare x ele of- LT -> SNode ele (insert xss l) e h- EQ -> SNode ele l (insert xs e) h- GT -> SNode ele l e (insert xss h)--- Insert new elements quickly-insert xss@(x:xs) SEnd =- singleton xss--- SEnd of word in non empty tree-insert [] t@(SNode ele l e h) = - case compare '\0' ele of- EQ -> t- LT -> SNode ele (insert [] l) e h--- SEnd of word in empty tree-insert [] SEnd =- SNode '\0' SEnd SEnd SEnd+ LT -> Node ele (insert xss l) e h+ EQ -> Node ele l (insert xs e) h+ GT -> Node ele l e (insert xss h) + -- | Quickly build an initial tree. singleton :: String -> StringSet-singleton (x:xs) = SNode x SEnd (singleton xs) SEnd-singleton [] = SNode '\0' SEnd SEnd SEnd+singleton (x:xs) = Node x End (singleton xs) End+singleton [] = Null End -- | Returns true if the string is in the StringSet 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) = +member _ End = False+member [] (Null _) = True+member [] (Node _ l _ _) = member [] l+member xss@(_:_) (Null rest) = member xss rest+member xss@(x:xs) (Node ele l e h) = case compare x ele of LT -> member xss l EQ -> member xs e@@ -52,109 +50,85 @@ -- | Returns the number of non-Null Elems treeSize :: StringSet -> Int-treeSize SEnd = 0-treeSize (SNode '\0' l e h) = treeSize l + treeSize e + treeSize h-treeSize (SNode _ l e h) = 1 + treeSize l + treeSize e + treeSize h+treeSize End = 0+treeSize (Null rest) = treeSize rest+treeSize (Node _ l e h) = 1 + treeSize l + treeSize e + treeSize h -- | Counts how many entries there are in the tree. 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+size End = 0+size (Null rest) = 1 + size rest+size (Node _ 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+fromList = foldl (flip insert) empty -- | An empty set. empty :: StringSet-empty = SEnd+empty = End -- | Returns true if the set is empty. null :: StringSet -> Bool-null SEnd = True-null _ = False+null End = True+null _ = False -- | A rather long Binary instance, that uses binary numbers to indicate--- where SEnds are efficiently.+-- where Ends are efficiently. instance Binary StringSet where- put (SNode ch SEnd SEnd SEnd) = do+ put (Node ch End End End) = do putWord8 0 put ch- put (SNode ch SEnd SEnd h) = do+ put (Node ch End End h) = do putWord8 1 put ch put h- put (SNode ch SEnd e SEnd) = do+ put (Node ch End e End) = do putWord8 2 put ch put e- put (SNode ch SEnd e h) = do+ put (Node ch End e h) = do putWord8 3 put ch put e put h- put (SNode ch l SEnd SEnd) = do+ put (Node ch l End End) = do putWord8 4 put ch put l- put (SNode ch l SEnd h) = do+ put (Node ch l End h) = do putWord8 5 put ch put l put h- put (SNode ch l e SEnd) = do+ put (Node ch l e End) = do putWord8 6 put ch put l put e -- General case- put (SNode ch l e h) = do+ put (Node ch l e h) = do putWord8 7 put ch put l put e put h- put SEnd = putWord8 8+ put End = putWord8 8+ put (Null rest) = do+ putWord8 9+ put rest get = do tag <- getWord8 case tag of- 8 -> return SEnd- _ -> do- ch <- get- -- [h,e,l] <- forM [0..2] $ \b -> if (tag `testBit` b) then get else return SEnd- -- return (SNode ch l e h)- case tag of- 0 -> return (SNode ch SEnd SEnd SEnd)- 1 -> do- h <- get- return (SNode ch SEnd SEnd h)- 2 -> do- e <- get- return (SNode ch SEnd e SEnd)- 3 -> do- e <- get- h <- get- return (SNode ch SEnd e h)- 4 -> do- l <- get- return (SNode ch l SEnd SEnd)- 5 -> do- l <- get- h <- get- return (SNode ch l SEnd h)- 6 -> do- l <- get- e <- get- return (SNode ch l e SEnd)- 7 -> do- l <- get- e <- get- h <- get- return (SNode ch l e h)- --+ _ | tag < 8 ->+ do+ ch <- get+ l <- if (tag `testBit` 2) then get else return End+ e <- if (tag `testBit` 1) then get else return End+ h <- if (tag `testBit` 0) then get else return End+ return (Node ch l e h)+ 9 -> liftM Null get+ _ -> return End
Data/Set/TernarySet.hs view
@@ -4,211 +4,170 @@ singleton, member, size,- Elem(..)+ fromList ) where+import Data.Bits import Data.Binary import Control.Monad -- | Elem a is used to hold elements of a list after insertion, and -- indicate that we've reached the end of the list.-data Elem a = C !a- | Null- deriving (Show, Eq)+-- data Elem a = C !a+-- | Null+-- deriving (Show, Eq) -- | TernarySet a is ternary tree. It is commonly used for storing word lists -- like dictionaries.-data TernarySet a = TNode !(Elem a) !(TernarySet a) !(TernarySet a) !(TernarySet a)- | TEnd+data TernarySet a = Node !a !(TernarySet a) !(TernarySet a) !(TernarySet a)+ | Null !(TernarySet a)+ | End deriving (Show, Eq) -- | All elements are greater than the Null Elem, otherwise they are -- ordered according to their own ord instance (for the `compare (C x) (C y)` case).-instance Ord a => Ord (Elem a) where- compare Null Null = EQ- compare Null x = LT- compare x Null = GT- compare (C x) (C y) = compare x y+-- instance Ord a => Ord (Elem a) where+-- compare Null Null = EQ+-- compare Null x = LT+-- compare x Null = GT+-- compare (C x) (C y) = compare x y -- | Quickly build a tree without an initial tree. This should be used -- to create an initial tree, using insert there after. singleton :: Ord a => [a] -> TernarySet a-singleton (x:xs) = TNode (C x) TEnd (singleton xs) TEnd-singleton [] = TNode Null TEnd TEnd TEnd+singleton (x:xs) = Node x End (singleton xs) End+singleton [] = Null End -- | Inserts an entries into a tree. insert :: Ord a => [a] -> TernarySet a -> TernarySet a--- General case-insert xss@(x:xs) (TNode ele l e h) =- case compare (C x) ele of- LT -> TNode ele (insert xss l) e h- EQ -> TNode ele l (insert xs e) h- GT -> TNode ele l e (insert xss h)--- Insert new elements quickly-insert xss@(x:xs) TEnd =- singleton xss--- TEnd of word in non empty tree-insert [] t@(TNode ele l e h) = - case compare Null ele of- EQ -> t- LT -> TNode ele (insert [] l) e h--- TEnd of word in empty tree-insert [] TEnd =- TNode Null TEnd TEnd TEnd+insert xss@(_:_) End = singleton xss+insert xss@(_:_) (Null rest) = Null $ insert xss rest+insert [] End = Null End+insert [] (Node ele l e h) = Node ele (insert [] l) e h+insert [] (Null rest) = Null rest+insert xss@(x:xs) (Node ele l e h) =+ case compare x ele of+ LT -> Node ele (insert xss l) e h+ EQ -> Node ele l (insert xs e) h+ GT -> Node ele l e (insert xss h) +-- -- General case+-- insert xss@(x:xs) (Node ele l e h) =+-- case compare x ele of+-- LT -> Node ele (insert xss l) e h+-- EQ -> Node ele l (insert xs e) h+-- GT -> Node ele l e (insert xss h)+-- -- Insert new elements quickly+-- insert xss@(_:_) End = singleton xss+-- -- End of word in non empty tree+-- insert [] t@(Null rest) = t+-- insert [] t@(Node ele l e h) = Node ele (insert [] l) e h+-- -- End of word in empty tree+-- insert [] End = Null End++ -- | Returns true if the `[a]` is in the TernarySet 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+member _ End = False+member [] (Null _) = True+member [] (Node _ l _ _) = member [] l+member xss@(_:_) (Null rest) = member xss rest+member xss@(x:xs) (Node ele l e h) = + case compare x ele of LT -> member xss l EQ -> member xs e GT -> member xss h -- | 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+treeSize End = 0+treeSize (Null rest) = treeSize rest+treeSize (Node _ l e h) = 1 + treeSize l + treeSize e + treeSize h -- | Counts how many entries there are in the tree. 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+size End = 0+size (Null rest) = 1 + size rest+size (Node _ 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+fromList = foldl (flip insert) empty -- | An empty set. empty :: TernarySet a -empty = TEnd+empty = End -- | Returns true if the set is empty. null :: TernarySet a -> Bool-null TEnd = True+null End = 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- 0 -> return Null- 1 -> liftM C get+-- 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+-- 0 -> return Null+-- 1 -> liftM C get --- | This binary uses the fact that the number of TEnds can be represented+-- | This binary uses the fact that the number of Ends can be represented -- in binary numbers to save a lot of space. instance Binary a => Binary (TernarySet a) where- put (TNode ch TEnd TEnd TEnd) = do+ put (Node ch End End End) = do putWord8 0 put ch- put (TNode ch TEnd TEnd h) = do+ put (Node ch End End h) = do putWord8 1 put ch put h- put (TNode ch TEnd e TEnd) = do+ put (Node ch End e End) = do putWord8 2 put ch put e- put (TNode ch TEnd e h) = do+ put (Node ch End e h) = do putWord8 3 put ch put e put h- put (TNode ch l TEnd TEnd) = do+ put (Node ch l End End) = do putWord8 4 put ch put l- put (TNode ch l TEnd h) = do+ put (Node ch l End h) = do putWord8 5 put ch put l put h- put (TNode ch l e TEnd) = do+ put (Node ch l e End) = do putWord8 6 put ch put l put e -- General case- put (TNode ch l e h) = do+ put (Node ch l e h) = do putWord8 7 put ch put l put e put h- put TEnd = putWord8 8+ put End = putWord8 8+ put (Null rest) = do+ putWord8 9+ put rest get = do tag <- getWord8 case tag of- 8 -> return TEnd- _ -> do- ch <- get- case tag of- 0 -> return (TNode ch TEnd TEnd TEnd)- 1 -> do- h <- get- return (TNode ch TEnd TEnd h)- 2 -> do- e <- get- return (TNode ch TEnd e TEnd)- 3 -> do- e <- get- h <- get- return (TNode ch TEnd e h)- 4 -> do- l <- get- return (TNode ch l TEnd TEnd)- 5 -> do- l <- get- h <- get- return (TNode ch l TEnd h)- 6 -> do- l <- get- e <- get- return (TNode ch l e TEnd)- 7 -> do- l <- get- e <- get- h <- get- return (TNode ch l e h)-----+ _ | tag < 8 ->+ do+ ch <- get+ l <- if (tag `testBit` 2) then get else return End+ e <- if (tag `testBit` 1) then get else return End+ h <- if (tag `testBit` 0) then get else return End+ return (Node ch l e h)+ 9 -> liftM Null get+ _ -> return End - -- put TEnd = put (0 :: Word8)- -- -- Quite common, so speecialised- -- put (TNode ch TEnd TEnd TEnd) = do- -- putWord8 1- -- put ch- -- -- Also common, basically what singleton produces.- -- put (TNode ch TEnd e TEnd) = do- -- putWord8 2- -- put ch- -- put e- -- -- General case- -- put (TNode ch l e h) = do- -- putWord8 3- -- put ch- -- put l- -- put e- -- put h- -- get = do- -- tag <- getWord8- -- case tag of- -- 0 -> return TEnd- -- 1 -> do- -- ch <- get- -- return (TNode ch TEnd TEnd TEnd)- -- 2 -> do- -- ch <- get- -- e <- get- -- return (TNode ch TEnd e TEnd)- -- 3 -> liftM4 TNode get get get get
TernaryTrees.cabal view
@@ -1,5 +1,5 @@ Name: TernaryTrees-Version: 0.1.0.0+Version: 0.1.1.0 Category: Data Structures Synopsis: Efficient pure ternary tree Sets and Maps Description: Ternary trees are an efficient structure often used for storing@@ -20,18 +20,14 @@ . New in this version: .- * 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.+ * Refactored a lot of the datatypes for the Sets (much of their code is+ exactly the same now) .- * Added a Functor instance for TernaryMap.+ * Made the get implementation shorter and clearer (thanks to olsner on IRC) .- * Added `empty` and `null` functions to all types, and `elems`- to TernaryMap.+ * There is now a darcs repo: <http://random.axman6.com/darcs/TernaryTrees/> .- © 2009 by Alex Mason (<http://axman6.homeip.net/blog/>). BSD3 license.+ © 2009 by Alex Mason (<http://random.axman6.com/blog/>). BSD3 license. License: BSD3 License-file: LICENSE.txt