[Trie works now
jupdike@gmail.com**20080205170735] {
hunk ./Main.lhs 12
-> import Support
-> import IOSupport
->
+ > import Support
+ > import IOSupport
+ >
+
addfile ./Trie.lhs
hunk ./Trie.lhs 1
+COMMENT:-----------------------
+
+Compile me with
+        ghc -c -O -fglasgow-exts Trie.lhs
+-------------------------------
+
+Tries
+
+
+> module Trie                   (  Trie,
+>                               -- construction
+>                                  empty, singleton, union, unionMany,
+>                                  add, (///),
+>                               -- construction with combining function
+>                               -- modification
+>                                  delete, deleteMany, minus,
+>                               -- conversion
+>                                  toList, fromList,
+>                               -- size
+>                                  genericLengthTrie, lengthTrie,
+>                               -- testing
+>                                  nullTrie, isSingleton,
+>                               -- extraction
+>                                  elemsTrie, indicesTrie,
+>                               -- lookup
+>                                  lookup, lookupWithDefault,
+>                                  lookupWithContinuation,
+>                               -- *additional functions*
+>                                  prefixLookup
+>                               )
+> where
+
+
+
+
+> import Subsequences           (  isPrefixOf  )
+
+> applyWithDefault              :: (a -> Maybe b) -> b -> a -> b
+> applyWithDefault f def a      =  case f a of Nothing -> def; Just v -> v
+
+
+
+
+> applyWithContinuation         :: (a -> Maybe b) -> (b -> c) -> c -> a -> c
+> applyWithContinuation f succ err a
+>                               =  case f a of Nothing -> err; Just v -> succ v
+
+
+
+ > import Support                (  applyWithDefault, applyWithContinuation  )
+
+
+
+Type definition
+
+
+> data Trie a b                 =  Leaf [a] b                    -- leaf node
+>                               |  Node [(a,Trie a b)] (Maybe b) -- inner node
+>                               deriving ()
+
+
+The value associated with the empty sequence is contained in the Maybe b part. Note: Node [('a',empty)] Nothing is not legal. A trie is printed as a set of bindings of the form a |-> v.
+
+
+> instance (Show a, Show b) => Show (Trie a b) where
+>     showsPrec d t             =  showBinds (toList t)
+>         where showBinds []    =  showString "{}"
+>               showBinds (b:x) =  showChar '{' . showBind b . showl x
+>               showl []        =  showChar '}'
+>               showl (b:x)     =  showString ", " . showBind b . showl x
+>               showBind (a,v)  =  shows a . showString " |-> " . shows v
+
+
+Further instances: Eq, Ord, ...?
+
+Construction
+empty constructs an empty trie.
+
+
+> empty                         :: Trie a b
+> empty                         =  Node [] Nothing
+
+
+
+
+> singleton                     :: ([a],b) -> Trie a b
+> singleton (x,v)               =  Leaf x v
+
+
+union and unionMany are quick hacks.
+
+
+> union                         :: Ord a => Trie a b -> Trie a b -> Trie a b
+> union t1 t2                   =  t1 /// toList t2
+
+
+
+
+> unionMany                     :: Ord a => [Trie a b] -> Trie a b
+> unionMany                     =  foldl union empty
+
+
+
+
+> add                           :: Ord a => ([a],b) -> Trie a b -> Trie a b
+> add (x,v) t                   =  insert t x v
+
+
+Note: /// instead of //.
+
+
+> (///)                         :: Ord a => Trie a b -> [([a],b)] -> Trie a b
+> t /// xvs                     =  foldl (flip add) t xvs
+
+
+
+Construction with combining function
+ToDo: union_C, unionMany_C, add_C, addMany_C.
+
+Modification
+ToDo: intersect.
+
+
+> delete                        :: Ord a => Trie a b -> [a] -> Trie a b
+> delete t@(Leaf y w) x
+>     | x==y                    =  empty
+>     | otherwise               =  t
+> delete (Node ts w) []         =  Node ts Nothing
+> delete (Node ts w) (a:x)      =  Node (delList ts) w
+>     where
+>     delList []                =  []
+>     delList ts@((b,t):us)     =  case compare b a of
+>         LT                    -> (b,t):delList us
+>         EQ                    -> case delete t x of
+>                                      Node [] Nothing -> us    -- rm empty node
+>                                      u               -> (b,u):us
+>         GT                    -> ts
+
+
+
+
+> deleteMany                    :: Ord a => Trie a b -> [[a]] -> Trie a b
+> deleteMany                    =  foldl delete
+
+
+minus is a quick hack.
+
+
+> minus                         :: Ord a => Trie a b -> Trie a b -> Trie a b
+> minus t1 t2                   =  t1 `deleteMany` indicesTrie t2
+
+
+ToDo: amap, partition, filter, foldl, foldr.
+
+Conversion
+
+
+> toList                        :: Trie a b -> [([a],b)]
+> toList t                      =  toLists [] t []
+
+
+
+
+> toLists s (Leaf x v)          =  put (reverseTo s x, v)
+> toLists s (Node ts w)         =  puts [ (reverse s, v) | Just v<-[w] ]
+>                               .  compose [ toLists (a:s) t | (a,t)<-ts ]
+
+
+toList (Leaf x w) = [ (x,w) ] toList (Node ts w) = [ ([],v) | Just v<-[w] ] ++ [ (a:x,w) | (a,t)<-ts, (x,w)<-toList t ] fromList is a quick hack.
+
+
+> fromList                      :: Ord a => [([a],b)] -> Trie a b
+> fromList                      =  foldl (flip add) empty
+
+
+
+Size
+Note: genericLengthTrie instead of genericLength. Dito: lengthTrie.
+
+
+> genericLengthTrie             :: Integral a => Trie b c -> a
+> genericLengthTrie (Leaf x w)  =  1
+> genericLengthTrie (Node ts w) =  sum [ genericLengthTrie t | (a,t)<-ts ]+len w
+>     where len Nothing         =  0
+>           len (Just _)        =  1
+
+
+
+
+> lengthTrie                    :: Trie a b -> Int
+> lengthTrie                    =  genericLengthTrie
+
+
+
+Testing
+Note: nullTrie instead of null.
+
+
+> nullTrie                      :: Trie a b -> Bool
+> nullTrie (Node [] Nothing)    =  True
+> nullTrie _                    =  False
+
+
+
+
+> isSingleton                   :: Trie a b -> Bool
+> isSingleton (Leaf x v)        =  True
+> isSingleton (Node [] (Just v))        =  True
+> isSingleton (Node [(a,t)] Nothing)    =  isSingleton t
+> isSingleton _                 =  False
+
+
+ToDo: intersecting, subsetT.
+
+Extraction
+Note: elemsTrie instead of elems. Dito: indicesTrie.
+
+
+> elemsTrie                     :: Trie a b -> [b]
+> elemsTrie                     =  map snd . toList
+
+
+
+
+> indicesTrie                   :: Trie a b -> [[a]]
+> indicesTrie                   =  map fst . toList
+
+
+
+Lookup
+
+
+> tlookup                        :: Ord a => Trie a b -> [a] -> Maybe b
+> tlookup (Leaf y w) x
+>     | x==y                    =  Just w
+>     | otherwise               =  Nothing
+> tlookup (Node ts w) []         =  w
+> tlookup (Node ts w) (a:x)      =  lookupList ts
+>     where
+>     lookupList []             =  Nothing
+>     lookupList ((b,t):ts)     =  case compare b a of
+>         LT                   -> lookupList ts
+>         EQ                   -> tlookup t x
+>         GT                   -> Nothing
+
+
+
+
+> lookupWithDefault             :: Ord a => Trie a b -> b -> [a] -> b
+> lookupWithDefault             =  applyWithDefault . tlookup
+
+
+
+
+> lookupWithContinuation        :: Ord a => Trie a b -> (b -> c) -> c -> [a] -> c
+> lookupWithContinuation        =  applyWithContinuation . tlookup
+
+
+
+Additional functions
+prefixLookup returns the list of all completions of the given list.
+
+
+> prefixLookup                  :: Ord a => Trie a b -> [a] -> [([a],b)]
+> prefixLookup (Leaf y w) x     =  [ (drop (length x) y,w) | x `isPrefixOf` y ]
+> prefixLookup t@(Node _ _) []  =  toList t
+> prefixLookup (Node ts _) (a:x)=  lookupList ts
+>     where
+>     lookupList []             =  []
+>     lookupList ((b,t):ts)     =  case compare b a of
+>         LT                   -> lookupList ts
+>         EQ                   -> prefixLookup t x
+>         GT                   -> []
+
+
+
+Auxiliary functions
+Insert an element into a trie. An existing entry is shadowed by the new entry.
+
+
+> insert                        :: Ord a => Trie a b -> [a] -> b -> Trie a b
+> insert (Leaf [] _) [] v       =  Leaf [] v
+> insert (Leaf (b:y) w) [] v    =  Node [(b,Leaf y w)] (Just v)
+> insert (Leaf [] w) (a:x) v    =  Node [(a,Leaf x v)] (Just w)
+> insert (Leaf (b:y) w) (a:x) v =  case compare b a of
+>     LT                        -> Node [(b,Leaf y w),(a,Leaf x v)] Nothing
+>     EQ                        -> Node [(a,insert (Leaf y w) x v)] Nothing
+>     GT                        -> Node [(a,Leaf x v),(b,Leaf y w)] Nothing
+> insert (Node ts w) [] v       =  Node ts (Just v)
+> insert (Node ts w) (a:x) v    =  Node (insList ts) w
+>     where
+>     insList []                =  [(a,Leaf x v)]
+>     insList ((b,t):ts)        =  case compare b a of
+>         LT                    -> (b,t):insList ts
+>         EQ                    -> (b,insert t x v):ts
+>         GT                    -> (a,Leaf x v):(b,t):ts
+
+
+
+
+> compose                       =  foldr (.) id
+
+
+
+
+> put                           =  (:)
+> puts                          =  (++)
+
+
+
+
+> reverseTo [] y                =  y
+> reverseTo (a:x) y             =  reverseTo x (a:y)
+
+
hunk ./g 6
-ghc --make Integrate.lhs
+#ghc --make Integrate.lhs
hunk ./g 8
+ghc --make Main.lhs
}