diff --git a/Data/Map/TernaryMap.hs b/Data/Map/TernaryMap.hs
--- a/Data/Map/TernaryMap.hs
+++ b/Data/Map/TernaryMap.hs
@@ -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
diff --git a/Data/Set/StringSet.hs b/Data/Set/StringSet.hs
--- a/Data/Set/StringSet.hs
+++ b/Data/Set/StringSet.hs
@@ -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
diff --git a/Data/Set/TernarySet.hs b/Data/Set/TernarySet.hs
--- a/Data/Set/TernarySet.hs
+++ b/Data/Set/TernarySet.hs
@@ -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
diff --git a/TernaryTrees.cabal b/TernaryTrees.cabal
--- a/TernaryTrees.cabal
+++ b/TernaryTrees.cabal
@@ -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:
.
- © 2009 by Alex Mason (). BSD3 license.
+ © 2009 by Alex Mason (). BSD3 license.
License: BSD3
License-file: LICENSE.txt