Advertisement
Guest User

Untitled

a guest
Feb 12th, 2016
57
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.49 KB | None | 0 0
  1. {-# LANGUAGE TypeFamilies #-}
  2. {-# LANGUAGE RankNTypes #-}
  3. {-# LANGUAGE FlexibleContexts #-}
  4. {-# LANGUAGE FunctionalDependencies #-}
  5. {-# LANGUAGE MultiParamTypeClasses #-}
  6. {-# LANGUAGE ViewPatterns #-}
  7.  
  8. module Main where
  9.  
  10. import qualified Data.ByteString.Char8 as C
  11. import qualified Data.ByteString.Lazy.Char8 as L
  12. import qualified Data.Foldable as F
  13. import qualified Data.Sequence as Seq
  14. import Data.Sequence(Seq)
  15. import qualified Data.IntMap.Strict as IntMap
  16. import Data.IntMap.Strict(IntMap)
  17. import Data.ByteString.Builder
  18. import Control.Applicative hiding (empty)
  19. import Control.Arrow
  20. import Control.Monad.Writer
  21. import Data.Monoid
  22. import Data.Char
  23. import System.IO (stdout)
  24. import Data.Maybe
  25.  
  26. class TrieMap s a where
  27. type TrieMapKey s :: * -> *
  28.  
  29. class TrieIsh s where
  30. type TrieElemType s :: *
  31. type TrieIndexType s :: *
  32. compress :: TrieElemType s -> TrieIndexType s
  33. uncompress :: TrieIndexType s -> TrieElemType s
  34.  
  35. instance TrieIsh C.ByteString where
  36. type TrieElemType C.ByteString = Char
  37. type TrieIndexType C.ByteString = Int
  38. compress = ord
  39. uncompress = chr
  40.  
  41. newtype Trie s a = Trie {
  42. unTrie :: (FiniteStream s) => IntMap (Maybe a, Trie s a)
  43. }
  44.  
  45. empty = Trie IntMap.empty
  46.  
  47. class (Monoid s) => FiniteStream s where
  48. type FiniteStreamElementType s :: *
  49. type FiniteStreamKeyType s :: *
  50. uncons :: s -> Maybe (FiniteStreamElementType s, s)
  51. isEmpty :: s -> Bool
  52. fromListS :: [FiniteStreamElementType s] -> s
  53. toListS :: s -> [FiniteStreamElementType s]
  54. fromKey :: FiniteStreamKeyType s -> FiniteStreamElementType s
  55. toKey :: FiniteStreamElementType s -> FiniteStreamKeyType s
  56.  
  57. instance FiniteStream C.ByteString where
  58. type FiniteStreamElementType C.ByteString = Char
  59. type FiniteStreamKeyType C.ByteString = Int
  60. uncons = C.uncons
  61. isEmpty = C.null
  62. fromListS = C.pack
  63. toListS = C.unpack
  64. fromKey = chr
  65. toKey = ord
  66.  
  67. instance (Bounded a, Integral a) => FiniteStream [a] where
  68. type FiniteStreamElementType [a] = a
  69. type FiniteStreamKeyType [a] = Int
  70. uncons [] = Nothing
  71. uncons (x:xs) = Just (x, xs)
  72. isEmpty [] = True
  73. isEmpty _ = False
  74. fromListS = id
  75. toListS = id
  76. fromKey = fromIntegral
  77. toKey = fromIntegral
  78.  
  79. member (uncons -> Nothing) _ = True
  80. member (uncons -> Just (c, cs)) (Trie t) = case IntMap.lookup k t of
  81. Nothing -> False
  82. Just (_, tr) -> member cs tr
  83. where k = toKey c
  84.  
  85. insertWith :: (FiniteStream s) => (a -> a -> a) -> s -> a -> Trie s a -> Trie s a
  86. insertWith f (uncons -> Nothing) v t = t
  87. insertWith f (uncons -> Just (c, cs)) v (Trie t)
  88. | isEmpty cs = case IntMap.lookup k t of
  89. Nothing -> Trie $ IntMap.insert k (Just v, empty) t
  90. Just _ -> Trie $ IntMap.update (Just . first (\x -> case x of
  91. Nothing -> Just v
  92. Just x' -> Just (f v x'))) k t
  93. | otherwise = case IntMap.lookup k t of
  94. Nothing -> Trie $ IntMap.insert k (Nothing, insertWith f cs v empty) t
  95. Just _ -> Trie $ IntMap.update (Just . fmap (insertWith f cs v) ) k t
  96. where k = toKey c :: FiniteStreamKeyType s
  97.  
  98. insert s v = insertWith const s v
  99. singleton k v = insertWith const k v empty
  100.  
  101. cons m t = mapM_ (uncurry (consM m)) (IntMap.assocs (unTrie t))
  102. consM m k (Nothing, t) = cons (m<>pure (fromKey k)) t
  103. consM m k (Just v, t) = let m' = m <> pure (fromKey k)
  104. in tell (Seq.singleton (F.toList m', v)) >> cons m' t
  105.  
  106. assocs t = F.toList $ execWriter (cons Seq.empty t)
  107.  
  108. instance (FiniteStream s, Show a) => Show (Trie s a) where
  109. show t = show $ execWriter (cons Seq.empty t)
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement