packages feed

monoids 0.1.10 → 0.1.13

raw patch · 5 files changed

+130/−16 lines, 5 files

Files

Data/Monoid/Generator.hs view
@@ -80,7 +80,7 @@  instance Generator [c] where     type Elem [c] = c-    mapReduce f = foldMap (unit . f)+    mapReduce f = foldr (cons . f) mempty  instance Measured v e => Generator (FingerTree v e) where     type Elem (FingerTree v e) = e
+ Data/Monoid/Generator/Free.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, ExistentialQuantification, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Monoid.Generator.Free+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  libraries@haskell.org+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-----------------------------------------------------------------------------++module Data.Monoid.Generator.Free+    ( module Data.Monoid.Generator+    , module Data.Monoid.Reducer+    , Free -- (AnyGen)+    ) where++import Control.Functor.Pointed+import Data.Monoid.Generator+import Data.Foldable+import Data.Monoid.Reducer+import Data.Monoid.Additive+import Data.Monoid.Self++data Free a +    = a `Cons` Free a+    | Free a `Snoc` a+    | Free a `Plus` Free a+    | Unit a+    | Empty+--    | forall c. (Generator c, Elem c ~ a) => AnyGen c++instance Monoid (Free a) where+    mempty = Empty+    mappend = Plus++instance Reducer a (Free a) where+    unit = Unit++    snoc Empty a = Unit a+    snoc a b = Snoc a b++    cons b Empty = Unit b+    cons a b = Cons a b ++instance Functor Free where+    fmap f (a `Cons` b) = f a `Cons` fmap f b+    fmap f (a `Snoc` b) = fmap f a `Snoc` f b+    fmap f (a `Plus` b) = fmap f a `Plus` fmap f b+    fmap f (Unit a) = Unit (f a)+    fmap _ Empty = Empty+--    fmap f (AnyGen c) = mapReduce f c++instance Pointed Free where+    point = Unit++instance Monad Free where+    return = Unit+    a `Cons` b >>= k = k a `Plus` (b >>= k)+    a `Snoc` b >>= k = (a >>= k) `Plus` k b+    a `Plus` b >>= k = (a >>= k) `Plus` (b >>= k)+    Unit a >>= k = k a+    Empty >>= _ = Empty+--  AnyGen c >>= k = ...++instance Foldable Free where+    foldMap f (a `Cons` b) = f a `mappend` foldMap f b+    foldMap f (a `Snoc` b) = foldMap f a `mappend` f b+    foldMap f (a `Plus` b) = foldMap f a `mappend` foldMap f b+    foldMap f (Unit a) = f a +    foldMap _ Empty = mempty+--    foldMap f (AnyGen c) = getSelf . mapReduce f c++instance Generator (Free a) where+    type Elem (Free a) = a+    mapReduce f (a `Cons` b) = f a `cons` mapReduce f b+    mapReduce f (a `Snoc` b) = mapReduce f a `snoc` f b+    mapReduce f (a `Plus` b) = mapReduce f a `plus` mapReduce f b+    mapReduce f (Unit a) = unit (f a)+    mapReduce _ Empty = mempty+--    mapReduce f (AnyGen c) = getSelf . mapReduce f c+    +    mapTo f m (a `Cons` b) = m `plus` (f a `cons` mapReduce f b)+    mapTo f m (a `Snoc` b) = mapTo f m a `snoc` f b+    mapTo f m (a `Plus` b) = mapTo f m a `plus` mapReduce f b+    mapTo f m (Unit a)     = m `snoc` f a+    mapTo _ m Empty        = m +--    mapTo f m (AnyGen c)   = getSelf . mapTo f m c+    +    mapFrom f (a `Cons` b) m = f a `cons` mapFrom f b m +    mapFrom f (a `Snoc` b) m = mapFrom f a (f b `cons` m)+    mapFrom f (a `Plus` b) m = mapReduce f a `plus` mapFrom f b m+    mapFrom f (Unit a)     m = f a `cons` m+    mapFrom _ Empty        m = m +--    mapFrom f (AnyGen c)   m = getSelf . mapFrom f c m
Data/Monoid/Generator/LZ78.hs view
@@ -23,7 +23,7 @@  module Data.Monoid.Generator.LZ78      ( module Data.Monoid.Generator-    , LZ78(LZ78, getLZ78)+    , LZ78     , decode     , encode     , encodeEq@@ -37,12 +37,21 @@ import Data.Map (Map) import qualified Data.List as List import Data.Monoid.Generator+import Data.Foldable import Data.Monoid.Self  -- | An LZ78 compressing 'Generator', which supports efficient 'mapReduce' operations -newtype LZ78 a = LZ78 { getLZ78 :: [(Int,a)] } +data Token a = Token a {-# UNPACK #-} !Int +    deriving (Eq,Ord,Show,Read) +-- after using the Functor instance the encoding may no longer be minimal+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 @@ -50,9 +59,16 @@     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 +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) @@ -66,11 +82,11 @@ 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+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 -> (p,c):encode' (Map.insert (p,c) f d) (succ f) 0 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.@@ -78,11 +94,11 @@ 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+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 -> (p,c):encodeEq' (((p,c),f):d) (succ f) 0 cs+    Nothing -> t : encodeEq' ((t,f):d) (succ f) 0 cs encodeEq' _ _ _ [] = []  -- | QuickCheck property: decode . encode = id
Data/Monoid/Generator/RLE.hs view
@@ -33,7 +33,7 @@ import qualified Data.Monoid.Combinators as Monoid  import Control.Functor.Pointed --- | A single run with a strict length+-- | A single run with a strict length. data Run a = Run a {-# UNPACK #-} !Int  instance Functor Run where
monoids.cabal view
@@ -1,5 +1,5 @@ name:		    monoids-version:	    0.1.10+version:	    0.1.13 license:	    BSD3 license-file:   LICENSE author:		    Edward A. Kmett@@ -39,6 +39,7 @@     Data.Monoid.Combinators     Data.Monoid.FromString     Data.Monoid.Generator+    Data.Monoid.Generator.Free     Data.Monoid.Generator.LZ78     Data.Monoid.Generator.RLE     Data.Monoid.Instances