[auto ekmett@gmail.com**20090329084835] { hunk ./doc/html/monoids/Data-Monoid-Generator-LZ78.html 277 +>Eq a => Eq (LZ78 a)Ord a => Ord (LZ78 a)Show a => Show (LZ78 a) -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) = mapTo' f (m `mappend` v) (s |> v) ws - where - v = Seq.index s w `mappend` unit (f c) - --- | a type-constrained 'reduce' operation - -decode :: LZ78 a -> [a] -decode = reduce - --- | contruct an LZ78-compressed 'Generator' using a 'Map' internally, requires an instance of Ord. - -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' _ _ _ [] = [] - --- | contruct an LZ78-compressed 'Generator' using a list internally, requires an instance of Eq. - -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' _ _ _ [] = [] - --- | QuickCheck property: decode . encode = id -prop_decode_encode :: Ord a => [a] -> Bool -prop_decode_encode xs = decode (encode xs) == xs - --- | QuickCheck property: decode . encodeEq = id -prop_decode_encodeEq :: Eq a => [a] -> Bool -prop_decode_encodeEq xs = decode (encodeEq xs) == xs + 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) = mapTo' f (m `mappend` v) (s |> v) ws + where + v = Seq.index s w `mappend` unit (f c) + +-- | a type-constrained 'reduce' operation + +decode :: LZ78 a -> [a] +decode = reduce + +-- | contruct an LZ78-compressed 'Generator' using a 'Map' internally, requires an instance of Ord. + +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' _ _ _ [] = [] + +-- | contruct an LZ78-compressed 'Generator' using a list internally, requires an instance of Eq. + +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' _ _ _ [] = [] + +-- | QuickCheck property: decode . encode = id +prop_decode_encode :: Ord a => [a] -> Bool +prop_decode_encode xs = decode (encode xs) == xs + +-- | QuickCheck property: decode . encodeEq = id +prop_decode_encodeEq :: Eq a => [a] -> Bool +prop_decode_encodeEq xs = decode (encodeEq xs) == xs }