module Data.Generator.Compressive.LZ78
( module Data.Generator
, LZ78
, decode
, encode
, encodeEq
, prop_decode_encode
, prop_decode_encodeEq
) where
import qualified Data.Sequence as Seq
import Data.Sequence (Seq,(|>))
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.List as List
import Data.Generator
import Data.Foldable
import Data.Monoid.Self
data Token a = Token a !Int
deriving (Eq,Ord,Show,Read)
instance Functor Token where
fmap f (Token a n) = Token (f a) n
newtype LZ78 a = LZ78 { getLZ78 :: [Token a] }
deriving (Eq,Ord,Show)
emptyDict :: Monoid m => Seq m
emptyDict = Seq.singleton mempty
instance Generator (LZ78 a) where
type Elem (LZ78 a) = a
mapTo f m (LZ78 xs) = mapTo' f m emptyDict xs
instance Functor LZ78 where
fmap f = LZ78 . fmap (fmap f) . getLZ78
instance Foldable LZ78 where
foldMap f = getSelf . mapReduce f
fold = getSelf . reduce
mapTo' :: (e `Reducer` m) => (a -> e) -> m -> Seq m -> [Token a] -> m
mapTo' _ m _ [] = m
mapTo' f m s (Token c w:ws) = m `mappend` mapTo' f v (s |> v) ws
where
v = Seq.index s w `mappend` unit (f c)
decode :: LZ78 a -> [a]
decode = reduce
encode :: Ord a => [a] -> LZ78 a
encode = LZ78 . encode' Map.empty 1 0
encode' :: Ord a => Map (Token a) Int -> Int -> Int -> [a] -> [Token a]
encode' _ _ p [c] = [Token c p]
encode' d f p (c:cs) = let t = Token c p in case Map.lookup t d of
Just p' -> encode' d f p' cs
Nothing -> t : encode' (Map.insert t f d) (succ f) 0 cs
encode' _ _ _ [] = []
encodeEq :: Eq a => [a] -> LZ78 a
encodeEq = LZ78 . encodeEq' [] 1 0
encodeEq' :: Eq a => [(Token a,Int)] -> Int -> Int -> [a] -> [Token a]
encodeEq' _ _ p [c] = [Token c p]
encodeEq' d f p (c:cs) = let t = Token c p in case List.lookup t d of
Just p' -> encodeEq' d f p' cs
Nothing -> t : encodeEq' ((t,f):d) (succ f) 0 cs
encodeEq' _ _ _ [] = []
prop_decode_encode :: Ord a => [a] -> Bool
prop_decode_encode xs = decode (encode xs) == xs
prop_decode_encodeEq :: Eq a => [a] -> Bool
prop_decode_encodeEq xs = decode (encodeEq xs) == xs