1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
|
{-
**************************************************************
* Author : Markus Forsberg *
* markus@cs.chalmers.se *
**************************************************************
-}
module Trie2 (
tcompile,
collapse,
Trie,
trieLookup
) where
import Map
newtype TrieT a b = TrieT ([(a,TrieT a b)],[b])
newtype Trie a b = Trie (Map a (Trie a b), [b])
emptyTrie = TrieT ([],[])
optimize :: Ord a => TrieT a b -> Trie a b
optimize (TrieT (xs,res)) = Trie ([(c,optimize t) | (c,t) <- xs] |->+ empty,
res)
collapse :: Ord a => Trie a b -> [([a],[b])]
collapse trie = collapse' trie []
where collapse' (Trie (map,(x:xs))) s = if (isEmpty map) then [(reverse s,(x:xs))]
else (reverse s,(x:xs)):
concat [ collapse' trie (c:s) | (c,trie) <- flatten map]
collapse' (Trie (map,[])) s
= concat [ collapse' trie (c:s) | (c,trie) <- flatten map]
tcompile :: Ord a => [([a],[b])] -> Trie a b
tcompile xs = optimize $ build xs emptyTrie
build :: Ord a => [([a],[b])] -> TrieT a b -> TrieT a b
build [] trie = trie
build (x:xs) trie = build xs (insert x trie)
where
insert ([],ys) (TrieT (xs,res)) = TrieT (xs,ys ++ res)
insert ((s:ss),ys) (TrieT (xs,res))
= case (span (\(s',_) -> s' /= s) xs) of
(xs,[]) -> TrieT (((s,(insert (ss,ys) emptyTrie)):xs),res)
(xs,(y,trie):zs) -> TrieT (xs ++ ((y,insert (ss,ys) trie):zs),res)
trieLookup :: Ord a => Trie a b -> [a] -> ([a],[b])
trieLookup trie s = apply trie s s
apply :: Ord a => Trie a b -> [a] -> [a] -> ([a],[b])
apply (Trie (_,res)) [] inp = (inp,res)
apply (Trie (map,_)) (s:ss) inp
= case map ! s of
Just trie -> apply trie ss inp
Nothing -> (inp,[])
|
