[auto ekmett@gmail.com**20090329045539] { hunk ./doc/html/monoids/Data-Monoid-Generator-LZ78.html 220 +>
encodeEq :: Eq a => [a] -> LZ78 aSource
prop_decode_encode :: Ord a => [a] -> BoolSource
prop_decode_encodeEq :: Eq a => [a] -> BoolSource
encodeEqData.Monoid.Generator.LZ78prop_decode_encodeData.Monoid.Generator.LZ78prop_decode_encodeEqData.Monoid.Generator.LZ78 ) where - -import qualified Data.Sequence as Seq -import Data.Sequence (Seq,(|>)) -import qualified Data.Map as Map -import Data.Map (Map) -import Data.Monoid.Generator -import Data.Monoid.Self - -newtype LZ78 a = LZ78 { getLZ78 :: [(Int,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 + , 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.Monoid.Generator +import Data.Monoid.Self + +newtype LZ78 a = LZ78 { getLZ78 :: [(Int,a)] } + +emptyDict :: Monoid m => Seq m +emptyDict = Seq.singleton mempty hunk ./doc/html/monoids/src/Data-Monoid-Generator-LZ78.html 33 -mapTo' :: (e `Reducer` m) => (a -> e) -> m -> Seq m -> [(Int,a)] -> m -mapTo' _ m _ [] = m -mapTo' f m s ((w,c):ws) = mapTo' f (m `mappend` 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 (Int,a) Int -> Int -> Int -> [a] -> [(Int,a)] -encode' _ _ p [c] = [(p,c)] -encode' d f p (c:cs) = case Map.lookup (p,c) d of - Just p' -> encode' d f p' cs - Nothing -> (p,c):encode' (Map.insert (p,c) f d) (succ f) 0 cs -encode' _ _ _ [] = [] - - --- QuickCheck properties, this holds as long as Eq is structural -prop_DecodeEncode :: Ord a => [a] -> Bool -prop_DecodeEncode xs = decode (encode xs) == xs +instance Generator (LZ78 a) where + type Elem (LZ78 a) = a + mapTo f m (LZ78 xs) = mapTo' f m emptyDict xs + +mapTo' :: (e `Reducer` m) => (a -> e) -> m -> Seq m -> [(Int,a)] -> m +mapTo' _ m _ [] = m +mapTo' f m s ((w,c):ws) = mapTo' f (m `mappend` 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 (Int,a) Int -> Int -> Int -> [a] -> [(Int,a)] +encode' _ _ p [c] = [(p,c)] +encode' d f p (c:cs) = case Map.lookup (p,c) d of + Just p' -> encode' d f p' cs + Nothing -> (p,c):encode' (Map.insert (p,c) f d) (succ f) 0 cs +encode' _ _ _ [] = [] + +encodeEq :: Eq a => [a] -> LZ78 a +encodeEq = LZ78 . encodeEq' [] 1 0 + +encodeEq' :: Eq a => [((Int,a),Int)] -> Int -> Int -> [a] -> [(Int,a)] +encodeEq' _ _ p [c] = [(p,c)] +encodeEq' d f p (c:cs) = case List.lookup (p,c) d of + Just p' -> encodeEq' d f p' cs + Nothing -> (p,c):encodeEq' (((p,c),f):d) (succ f) 0 cs +encodeEq' _ _ _ [] = [] + +-- QuickCheck properties, this holds as long as Ord is structural +prop_decode_encode :: Ord a => [a] -> Bool +prop_decode_encode xs = decode (encode xs) == xs + +-- QuickCheck properties, this holds as long as Eq is structural +prop_decode_encodeEq :: Eq a => [a] -> Bool +prop_decode_encodeEq xs = decode (encodeEq xs) == xs }