fork download
  1. -- Trie, yet another implementation
  2. -- (c) Vadim Vinnik, 2011
  3.  
  4. data Trie = Trie Bool [TrieEdge] deriving Show
  5. data TrieEdge = TrieEdge Char Trie deriving Show
  6.  
  7. trieEmpty = Trie False []
  8.  
  9. trieInsert :: Trie -> String -> Trie
  10. trieInsert (Trie _ l) [] = Trie True l
  11. trieInsert (Trie x l) s = Trie x (f l s) where
  12. f [] (a:b) = [h a b]
  13. f l1@(e@(TrieEdge c1 t):l2) s@(c2:s2)
  14. | c1 == c2 = (TrieEdge c1 (trieInsert t s2)):l2
  15. | c1 > c2 = (h c2 s2) : l1
  16. | otherwise = e : (f l2 s)
  17. h a b = TrieEdge a (trieInsert trieEmpty b)
  18.  
  19. trieExists :: Trie -> String -> Bool
  20. trieExists (Trie x _) [] = x
  21. trieExists (Trie _ l) s = f l s where
  22. f [] _ = False
  23. f ((TrieEdge c1 t):l2) s@(c2:s2)
  24. | c1 == c2 = trieExists t s2
  25. | otherwise = f l2 s
  26.  
  27. trieToString :: Trie -> String
  28. trieToString t = h t " " where
  29. h (Trie x l) s = (if x then "#" else "") ++ '\n' : (foldl (++) "" (map f l)) where
  30. f (TrieEdge c t) = (s ++ (c:[]) ++ (h t (" " ++ s)))
  31.  
  32. trieFromText :: String -> Trie
  33. trieFromText s = foldl trieInsert trieEmpty (words s)
  34.  
  35. trieAllWords :: Trie -> [String]
  36. trieAllWords (Trie x l) = (if x then "":r else r) where
  37. r = foldl (++) [] (map f l) where
  38. f (TrieEdge c t) = map (c:) (trieAllWords t)
  39.  
  40. trieEndings :: Trie -> String -> [String]
  41. trieEndings t [] = trieAllWords t
  42. trieEndings (Trie _ l) s = f l s where
  43. f [] _ = []
  44. f ((TrieEdge c1 t1):l1) s1@(c2:s2)
  45. | c1 == c2 = trieEndings t1 s2
  46. | c1 < c2 = f l1 s1
  47. | otherwise = []
  48.  
  49. trieCompletions :: Trie -> String -> [String]
  50. trieCompletions t s = map (s++) (trieEndings t s)
  51.  
  52. main = do s <- getLine
  53. let t = trieFromText s
  54. putStr (trieToString t)
  55. print (trieAllWords t)
  56. print (trieEndings t "wh")
  57. print (trieCompletions t "wi")
  58.  
stdin
what which witch when where will wire wind window
compilation info
[1 of 1] Compiling Main             ( prog.hs, prog.o )
Linking prog ...
stdout
 w
  h
   a
    t#
   e
    n#
    r
     e#
   i
    c
     h#
  i
   l
    l#
   n
    d#
     o
      w#
   r
    e#
   t
    c
     h#
["what","when","where","which","will","wind","window","wire","witch"]
["at","en","ere","ich"]
["will","wind","window","wire","witch"]