packages feed

monoids 0.1.21 → 0.1.25

raw patch · 30 files changed

+1048/−799 lines, 30 files

Files

+ Data/Field.hs view
@@ -0,0 +1,29 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Field+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Data.Field+    ( module Data.Group.Multiplicative+    , module Data.Ring+    , Field+    ) where++import Data.Group.Multiplicative+import Data.Ring+import Data.Monoid.Self+import Data.Monoid.FromString+import Data.Monoid.Reducer++class (Ring a, MultiplicativeGroup a) => Field a++instance Field f => Field (Dual f)+instance Field f => Field (Self f)+instance Field f => Field (FromString f)+instance Field f => Field (ReducedBy f s)
+ Data/Field/VectorSpace.hs view
@@ -0,0 +1,11 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+module Data.Field.VectorSpace +    ( module Data.Field+    , module Data.Ring.Module+    , VectorSpace+    ) where++import Data.Field+import Data.Ring.Module+    +class (Field f, Module f g) => VectorSpace f g
+ Data/Generator.hs view
@@ -0,0 +1,186 @@+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Generator+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- A 'Generator' @c@ is a possibly-specialized container, which contains values of +-- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract+-- an answer.+--+-- Since a 'Generator' is not polymorphic in its contents, it is more specialized+-- than "Data.Foldable.Foldable", and a 'Reducer' may supply efficient left-to-right+-- and right-to-left reduction strategies that a 'Generator' may avail itself of.+-----------------------------------------------------------------------------++module Data.Generator+    ( module Data.Monoid.Reducer+    -- * Generators+    , Generator+    , Elem+    , mapReduce+    , mapTo+    , mapFrom+    -- * Generator Transformers+    , Keys(Keys, getKeys)+    , Values(Values, getValues)+    , Char8(Char8, getChar8)+    -- * Combinators+    , reduce+    , mapReduceWith+    , reduceWith+    ) where++import Data.Array +import Data.Word (Word8)+import Data.Text (Text)+import Data.Foldable (fold,foldMap)+import qualified Data.Text as Text+import qualified Data.ByteString as Strict (ByteString, foldl')+import qualified Data.ByteString.Char8 as Strict8 (foldl')+import qualified Data.ByteString.Lazy as Lazy (ByteString, toChunks)+import qualified Data.ByteString.Lazy.Char8 as Lazy8 (toChunks)+import qualified Data.Sequence as Seq+import Data.FingerTree (Measured, FingerTree)+import Data.Sequence (Seq)+import qualified Data.Set as Set+import Data.Set (Set)+import qualified Data.IntSet as IntSet+import Data.IntSet (IntSet)+import qualified Data.IntMap as IntMap+import Data.IntMap (IntMap)+import qualified Data.Map as Map+import Data.Map (Map)++import Control.Parallel.Strategies+import Data.Monoid.Reducer++-- | minimal definition 'mapReduce' or 'mapTo'+class Generator c where+    type Elem c :: * +    mapReduce :: (e `Reducer` m) => (Elem c -> e) -> c -> m+    mapTo     :: (e `Reducer` m) => (Elem c -> e) -> m -> c -> m +    mapFrom   :: (e `Reducer` m) => (Elem c -> e) -> c -> m -> m++    mapReduce f = mapTo f mempty+    mapTo f m = mappend m . mapReduce f+    mapFrom f = mappend . mapReduce f++instance Generator Strict.ByteString where+    type Elem Strict.ByteString = Word8+    mapTo f = Strict.foldl' (\a -> snoc a . f)++instance Generator Lazy.ByteString where+    type Elem Lazy.ByteString = Word8+    mapReduce f = fold . parMap rwhnf (mapReduce f) . Lazy.toChunks++instance Generator Text where+    type Elem Text = Char+    mapTo f = Text.foldl' (\a -> snoc a . f)++instance Generator [c] where+    type Elem [c] = c+    mapReduce f = foldr (cons . f) mempty++instance Measured v e => Generator (FingerTree v e) where+    type Elem (FingerTree v e) = e+    mapReduce f = foldMap (unit . f)++instance Generator (Seq c) where+    type Elem (Seq c) = c+    mapReduce f = foldMap (unit . f)++instance Generator IntSet where+    type Elem IntSet = Int+    mapReduce f = mapReduce f . IntSet.toList++instance Generator (Set a) where+    type Elem (Set a) = a+    mapReduce f = mapReduce f . Set.toList++instance Generator (IntMap v) where+    type Elem (IntMap v) = (Int,v)+    mapReduce f = mapReduce f . IntMap.toList++instance Generator (Map k v) where+    type Elem (Map k v) = (k,v) +    mapReduce f = mapReduce f . Map.toList++instance Ix i => Generator (Array i e) where+    type Elem (Array i e) = (i,e)+    mapReduce f = mapReduce f . assocs++-- | a 'Generator' transformer that asks only for the keys of an indexed container+newtype Keys c = Keys { getKeys :: c } ++instance Generator (Keys (IntMap v)) where+    type Elem (Keys (IntMap v)) = Int+    mapReduce f = mapReduce f . IntMap.keys . getKeys++instance Generator (Keys (Map k v)) where+    type Elem (Keys (Map k v)) = k+    mapReduce f = mapReduce f . Map.keys . getKeys++instance Ix i => Generator (Keys (Array i e)) where+    type Elem (Keys (Array i e)) = i+    mapReduce f = mapReduce f . range . bounds . getKeys++-- | a 'Generator' transformer that asks only for the values contained in an indexed container+newtype Values c = Values { getValues :: c } ++instance Generator (Values (IntMap v)) where+    type Elem (Values (IntMap v)) = v+    mapReduce f = mapReduce f . IntMap.elems . getValues++instance Generator (Values (Map k v)) where+    type Elem (Values (Map k v)) = v+    mapReduce f = mapReduce f . Map.elems . getValues++instance Ix i => Generator (Values (Array i e)) where+    type Elem (Values (Array i e)) = e+    mapReduce f = mapReduce f . elems . getValues++-- | a 'Generator' transformer that treats 'Word8' as 'Char'+-- This lets you use a 'ByteString' as a 'Char' source without going through a 'Monoid' transformer like 'UTF8'+newtype Char8 c = Char8 { getChar8 :: c } ++instance Generator (Char8 Strict.ByteString) where+    type Elem (Char8 Strict.ByteString) = Char+    mapTo f m = Strict8.foldl' (\a -> snoc a . f) m . getChar8++instance Generator (Char8 Lazy.ByteString) where+    type Elem (Char8 Lazy.ByteString) = Char+    mapReduce f = fold . parMap rwhnf (mapReduce f . Char8) . Lazy8.toChunks . getChar8++-- | Apply a 'Reducer' directly to the elements of a 'Generator'+reduce :: (Generator c, Elem c `Reducer` m) => c -> m+reduce = mapReduce id+{-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Strict.ByteString -> m #-}+{-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Lazy.ByteString -> m #-}+{-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Strict.ByteString -> m #-}+{-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Lazy.ByteString -> m #-}+{-# SPECIALIZE reduce :: (c `Reducer` m) => [c] -> m #-}+{-# SPECIALIZE reduce :: (Generator (FingerTree v e), e `Reducer` m) => FingerTree v e -> m #-}+{-# SPECIALIZE reduce :: (Char `Reducer` m) => Text -> m #-}+{-# SPECIALIZE reduce :: (e `Reducer` m) => Seq e -> m #-}+{-# SPECIALIZE reduce :: (Int `Reducer` m) => IntSet -> m #-}+{-# SPECIALIZE reduce :: (a `Reducer` m) => Set a -> m #-}+{-# SPECIALIZE reduce :: ((Int,v) `Reducer` m) => IntMap v -> m #-}+{-# SPECIALIZE reduce :: ((k,v) `Reducer` m) => Map k v -> m #-}+{-# SPECIALIZE reduce :: (Int `Reducer` m) => Keys (IntMap v) -> m #-}+{-# SPECIALIZE reduce :: (k `Reducer` m) => Keys (Map k v) -> m #-}+{-# SPECIALIZE reduce :: (v `Reducer` m) => Values (IntMap v) -> m #-}+{-# SPECIALIZE reduce :: (v `Reducer` m) => Values (Map k v) -> m #-}++mapReduceWith :: (Generator c, e `Reducer` m) => (m -> n) -> (Elem c -> e) -> c -> n+mapReduceWith f g = f . mapReduce g+{-# INLINE mapReduceWith #-}++reduceWith :: (Generator c, Elem c `Reducer` m) => (m -> n) -> c -> n+reduceWith f = f . reduce+{-# INLINE reduceWith #-}
+ Data/Generator/Combinators.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Generator.Combinators+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (type families, MPTCs)+--+-- Utilities for working with Monoids that conflict with names from the "Prelude",+-- "Data.Foldable", "Control.Monad" or elsewhere. Intended to be imported qualified.+--+-- > import Data.Generator.Combinators as Generator+--+-----------------------------------------------------------------------------++module Data.Generator.Combinators+    ( module Data.Generator+    -- * Monadic Reduction+    , mapM_+    , forM_+    , msum+    -- * Applicative Reduction+    , traverse_+    , for_+    , asum+    -- * Logical Reduction+    , and+    , or+    , any+    , all+    -- * Monoidal Reduction+    , foldMap+    , fold+    , toList +    -- * List-Like Reduction+    , concatMap+    , elem+    , filter+    , filterWith+    , find+    , sum+    , product+    , notElem+    ) where++import Prelude hiding (mapM_, any, elem, filter, concatMap, and, or, all, sum, product, notElem, replicate, cycle, repeat)+import Control.Applicative+import Control.Monad (MonadPlus)+import Data.Generator+import Data.Monoid.Applicative+import Data.Monoid.Self+import Data.Monoid.Monad++-- | Efficiently 'mapReduce' a 'Generator' using the 'Traversal' monoid. A specialized version of its namesake from "Data.Foldable"+--+-- @+--     'mapReduce' 'getTraversal'+-- @+traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f ()+traverse_ = mapReduceWith getTraversal+{-# INLINE traverse_ #-}+    +-- | Convenience function as found in "Data.Foldable"+--+-- @+--     'flip' 'traverse_'+-- @+for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f ()+for_ = flip traverse_+{-# INLINE for_ #-}++-- | The sum of a collection of actions, generalizing 'concat'+--+-- @+--    'reduceWith' 'getAlt'+-- @ +asum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f a+asum = reduceWith getAlt+{-# INLINE asum #-}++-- | Efficiently 'mapReduce' a 'Generator' using the 'Action' monoid. A specialized version of its namesake from "Data.Foldable" and "Control.Monad"+-- +-- @+--    'mapReduceWith' 'getAction'+-- @ +mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m ()+mapM_ = mapReduceWith getAction+{-# INLINE mapM_ #-}++-- | Convenience function as found in "Data.Foldable" and "Control.Monad"+--+-- @+--     'flip' 'mapM_'+-- @+forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m ()+forM_ = flip mapM_+{-# INLINE forM_ #-}++-- | The sum of a collection of actions, generalizing 'concat'+--+-- @+--     'reduceWith' 'getMonadSum'+-- @+msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m a+msum = reduceWith getMonadSum+{-# INLINE msum #-}++-- | Efficiently 'mapReduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable"+--+-- @+--     'mapReduceWith' 'getSelf'+-- @+foldMap :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m+foldMap = mapReduceWith getSelf+{-# INLINE foldMap #-}++-- | Type specialization of "foldMap" above+concatMap :: Generator c => (Elem c -> [b]) -> c -> [b]+concatMap = foldMap+{-# INLINE concatMap #-}++-- | Efficiently 'reduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable"+--+-- @+--     'reduceWith' 'getSelf'+-- @+fold :: (Monoid m, Generator c, Elem c ~ m) => c -> m+fold = reduceWith getSelf+{-# INLINE fold #-}++-- | Convert any 'Generator' to a list of its contents. Specialization of 'reduce'+toList :: Generator c => c -> [Elem c]+toList = reduce+{-# INLINE toList #-}++-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'+--+-- @+--     'reduceWith' 'getAll'+-- @+and :: (Generator c, Elem c ~ Bool) => c -> Bool+and = reduceWith getAll+{-# INLINE and #-}++-- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'+--+-- @+--     'reduceWith' 'getAny'+-- @+or :: (Generator c, Elem c ~ Bool) => c -> Bool+or = reduceWith getAny+{-# INLINE or #-}++-- | Efficiently 'mapReduce' any 'Generator' checking to see if any of its values match the supplied predicate+--+-- @+--     'mapReduceWith' 'getAny'+-- @+any :: Generator c => (Elem c -> Bool) -> c -> Bool+any = mapReduceWith getAny+{-# INLINE any #-}++-- | Efficiently 'mapReduce' any 'Generator' checking to see if all of its values match the supplied predicate+--+-- @+--     'mapReduceWith' 'getAll'+-- @+all :: Generator c => (Elem c -> Bool) -> c -> Bool+all = mapReduceWith getAll+{-# INLINE all #-}++-- | Efficiently sum over the members of any 'Generator'+--+-- @+--     'reduceWith' 'getSum'+-- @+sum :: (Generator c, Num (Elem c)) => c -> Elem c+sum = reduceWith getSum+{-# INLINE sum #-}++-- | Efficiently take the product of every member of a 'Generator'+--+-- @+--     'reduceWith' 'getProduct'+-- @+product :: (Generator c, Num (Elem c)) => c -> Elem c+product = reduceWith getProduct+{-# INLINE product #-}++-- | Check to see if 'any' member of the 'Generator' matches the supplied value+elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool+elem = any . (==)+{-# INLINE elem #-}++-- | Check to make sure that the supplied value is not a member of the 'Generator'+notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool+notElem x = not . elem x+{-# INLINE notElem #-}++-- | Efficiently 'mapReduce' a subset of the elements in a 'Generator'+filter :: (Generator c, Elem c `Reducer` m) => (Elem c -> Bool) -> c -> m+filter p = foldMap f where+    f x | p x = unit x+        | otherwise = mempty+{-# INLINE filter #-}++-- | Allows idiomatic specialization of filter by proving a function that will be used to transform the output+filterWith :: (Generator c, Elem c `Reducer` m) => (m -> n) -> (Elem c -> Bool) -> c -> n +filterWith f p = f . filter p+{-# INLINE filterWith #-}++-- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find'+--+-- @+--     'filterWith' 'getFirst'+-- @+find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c)+find = filterWith getFirst+{-# INLINE find #-}+
+ Data/Generator/Compressive/LZ78.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Generator.Compressive.LZ78+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Compression algorithms are all about exploiting redundancy. When applying+-- an expensive 'Reducer' to a redundant source, it may be better to +-- extract the structural redundancy that is present. 'LZ78' is a compression+-- algorithm that does so, without requiring the dictionary to be populated+-- with all of the possible values of a data type unlike its later +-- refinement LZW, and which has fewer comparison reqirements during encoding+-- than its earlier counterpart LZ77. Since we aren't storing these as a +-- bitstream the LZSS refinement of only encoding pointers once you cross+-- the break-even point is a net loss. +-----------------------------------------------------------------------------+++module Data.Generator.Compressive.LZ78 +    ( module Data.Generator+    -- * Lempel-Ziv 78 +    , LZ78+    -- * Decoding+    , decode+    -- * Encoding+    , encode+    , encodeEq+    -- * QuickCheck Properties+    , 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++-- | An LZ78 compressing 'Generator', which supports efficient 'mapReduce' operations++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++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)++-- | 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
+ Data/Generator/Compressive/RLE.hs view
@@ -0,0 +1,101 @@+{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, TypeOperators, FlexibleInstances, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Generator.Compressive.RLE+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Compression algorithms are all about exploiting redundancy. When applying+-- an expensive 'Reducer' to a redundant source, it may be better to +-- extract the structural redundancy that is present. Run length encoding+-- can do so for long runs of identical inputs.+-----------------------------------------------------------------------------++module Data.Generator.Compressive.RLE+    ( module Data.Generator+    , RLE(RLE, getRLE)+    , Run(Run)+    , decode+    , encode+    , encodeList+    , prop_decode_encode+    , prop_decode_encodeList+    ) where++import qualified Data.Sequence as Seq+import Data.Sequence (Seq,(|>),(<|),ViewL(..),ViewR(..),(><),viewl,viewr)+import Data.Foldable+import Data.Generator+import qualified Data.Monoid.Combinators as Monoid +import Control.Functor.Pointed++-- | A single run with a strict length.+data Run a = Run a {-# UNPACK #-} !Int++instance Functor Run where+    fmap f (Run a n) = Run (f a) n++instance Pointed Run where+    point a = Run a 1++-- | A 'Generator' which supports efficient 'mapReduce' operations over run-length encoded data.+newtype RLE f a = RLE { getRLE :: f (Run a) } ++instance Functor f => Functor (RLE f) where+    fmap f = RLE . fmap (fmap f) . getRLE++instance Foldable f => Generator (RLE f a) where+    type Elem (RLE f a) = a+    mapReduce f = foldMap run . getRLE where+        run (Run a n) = unit (f a) `Monoid.replicate` n++decode :: Foldable f => RLE f a -> [a]+decode = reduce++-- | naive left to right encoder, which can handle infinite data++encodeList :: Eq a => [a] -> RLE [] a+encodeList [] = RLE []+encodeList (a:as) = RLE (point a `before` as)++before :: Eq a => Run a -> [a] -> [Run a]+r           `before` []                 = [r]+r@(Run a n) `before` (b:bs) | a == b    = Run a (n+1) `before` bs+                            | otherwise = r : point b `before` bs++-- | QuickCheck property: decode . encode = id+prop_decode_encodeList :: Eq a => [a] -> Bool+prop_decode_encodeList xs = decode (encode xs) == xs++-- One nice property that run-length encoding has is that it can be computed monoidally as follows+-- However, this monoid cannot be used to handle infinite sources.++instance Eq a => Monoid (RLE Seq a) where+    mempty = RLE Seq.empty+    RLE l `mappend` RLE r = viewr l `merge` viewl r where+        (l' :> Run a m) `merge` (Run b n :< r')+            | a == b     = RLE ((l' |> Run a (m+n)) >< r')+            | otherwise  = RLE (l >< r)+        EmptyR `merge` _ = RLE r+        _ `merge` EmptyL = RLE l++instance Eq a => Reducer a (RLE Seq a) where+    unit = RLE . Seq.singleton . point+    cons a (RLE r) = case viewl r of+            Run b n :< r' | a == b    -> RLE (Run a (n+1) <| r')+                          | otherwise -> RLE (Run a 1     <| r )+            EmptyL                    -> RLE (return (point a))+    snoc (RLE l) a = case viewr l of+            l' :> Run b n | a == b    -> RLE (l' |> Run b (n+1))+                          | otherwise -> RLE (l  |> Run a 1    )+            EmptyR                    -> RLE (return (point a))++encode :: (Generator c, Eq (Elem c)) => c -> RLE Seq (Elem c)+encode = reduce++prop_decode_encode :: (Generator c, Eq (Elem c)) => c -> Bool+prop_decode_encode xs = decode (encode xs) == reduce xs
+ Data/Generator/Free.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, ExistentialQuantification, TypeFamilies #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Generator.Free+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  non-portable (MPTCs)+--+-----------------------------------------------------------------------------++module Data.Generator.Free+    ( module Data.Generator+    , module Data.Monoid.Reducer+    , Free (AnyGenerator)+    ) where++import Control.Functor.Pointed+import Control.Monad+import Data.Generator+import Data.Foldable+import Data.Monoid.Reducer+import Data.Monoid.Additive+import qualified Data.Generator.Combinators as Generator+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) => AnyGenerator c++instance Eq a => Eq (Free a) where+    a == b = Generator.toList a == Generator.toList b+    a /= b = Generator.toList a == Generator.toList b++instance Ord a => Ord (Free a) where+    a <= b = Generator.toList a <= Generator.toList b+    a >= b = Generator.toList a >= Generator.toList b+    a < b  = Generator.toList a <  Generator.toList b+    a > b  = Generator.toList a >  Generator.toList b+    a `compare` b = Generator.toList a `compare` Generator.toList b++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 (AnyGenerator 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+    AnyGenerator c >>= k = getSelf (mapReduce k c)++instance MonadPlus Free where+    mzero = Empty+    mplus = Plus++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 (AnyGenerator c) = Generator.foldMap 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 (AnyGenerator c) = 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 (AnyGenerator c)   = 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 (AnyGenerator c) m = mapFrom f c m
Data/Group.hs view
@@ -22,6 +22,7 @@ import Data.Monoid.Additive import Data.Monoid.Self import Data.Monoid.FromString+import Data.Monoid.Reducer  infixl 6 `minus` @@ -54,3 +55,8 @@ instance Group a => Group (FromString a) where     gnegate = FromString . gnegate . getFromString     FromString a `minus` FromString b = FromString (a `minus` b)++instance Group a => Group (ReducedBy a s) where+    gnegate = Reduction . gnegate . getReduction+    Reduction a `minus` Reduction b = Reduction (a `minus` b)+
+ Data/Group/Multiplicative.hs view
@@ -0,0 +1,56 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Group.Multiplicative+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-----------------------------------------------------------------------------++module Data.Group.Multiplicative +    ( module Data.Monoid.Multiplicative+    , module Data.Group+    , MultiplicativeGroup+    , over+    , under+    , grecip+    ) where++import Data.Monoid.Multiplicative+import Data.Group+import Data.Monoid.Self+import Data.Monoid.FromString+import Data.Monoid.Reducer++    +-- | Minimal definition over or grecip+class Multiplicative g => MultiplicativeGroup g where+    -- | @x / y@+    over :: g -> g -> g+    -- | @x \ y@+    under :: g -> g -> g+    grecip :: g -> g++    x `under` y = grecip x `times` y+    x `over` y = x `times` grecip y+    grecip x = one `over` x++instance MultiplicativeGroup g => MultiplicativeGroup (Self g) where+    Self x `over` Self y = Self (x `over` y)+    Self x `under` Self y = Self (x `under` y)+    grecip (Self x) = Self (grecip x)++instance MultiplicativeGroup g => MultiplicativeGroup (FromString g) where+    FromString x `over` FromString y = FromString (x `over` y)+    FromString x `under` FromString y = FromString (x `under` y)+    grecip (FromString x) = FromString (grecip x)++instance MultiplicativeGroup g => MultiplicativeGroup (ReducedBy g s) where+    Reduction x `over` Reduction y = Reduction (x `over` y)+    Reduction x `under` Reduction y = Reduction (x `under` y)+    grecip (Reduction x) = Reduction (grecip x)++instance MultiplicativeGroup a => MultiplicativeGroup (Dual a) where+    grecip = Dual . grecip . getDual
+ Data/Group/Multiplicative/Sugar.hs view
@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Group.Multiplicative.Sugar+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable+--+-- Syntactic sugar for working with groups that conflicts with names from the "Prelude".+--+-- > import Prelude hiding ((-), (+), (*), (/), negate, subtract, recip)+-- > import Data.Group.Multiplicative.Sugar+--+-----------------------------------------------------------------------------++module Data.Group.Multiplicative.Sugar +    ( module Data.Monoid.Multiplicative.Sugar+    , module Data.Group.Multiplicative+    , module Data.Group.Sugar+    , (/)+    , (\\)+    , recip+    ) where++import Data.Group.Multiplicative+import Data.Monoid.Multiplicative.Sugar+import Data.Group.Sugar+import Prelude hiding ((-), (+), (*), (/), negate, subtract, recip)++infixl 7 /+infixr 7 \\++(/) :: MultiplicativeGroup g => g -> g -> g+(/) = over++(\\) :: MultiplicativeGroup g => g -> g -> g+(\\) = under++recip :: MultiplicativeGroup g => g -> g+recip = grecip
Data/Monoid/Applicative.hs view
@@ -53,7 +53,7 @@  -- | A 'Alt' turns any 'Alternative' instance into a 'Monoid'. --   It also provides a 'Multiplicative' instance for an 'Applicative' functor wrapped around a 'Monoid'---   and asserts that any 'Alternative' applied to a 'Monoid' forms a 'LeftSemiNearRing' +--   and asserts that any 'Alternative' applied to a 'Monoid' forms a 'RightSemiNearRing'  --   under these operations.  newtype Alt f a = Alt { getAlt :: f a } @@ -73,7 +73,7 @@ instance Alternative f => Reducer (f a) (Alt f a) where     unit = Alt  -instance (Alternative f, Monoid a) => LeftSemiNearRing (Alt f a)+instance (Alternative f, Monoid a) => RightSemiNearRing (Alt f a)  -- | if @m@ is a 'Module' over @r@ and @f@ is a 'Applicative' then @f `App` m@ is a 'Module' over @r@ as well
Data/Monoid/Combinators.hs view
@@ -12,221 +12,33 @@ -- Utilities for working with Monoids that conflict with names from the "Prelude", -- "Data.Foldable", "Control.Monad" or elsewhere. Intended to be imported qualified. ----- > import Data.Group.Combinators as Monoid +-- > import Data.Monoid.Combinators as Monoid  -- -----------------------------------------------------------------------------  module Data.Monoid.Combinators-    ( module Data.Monoid.Generator-    -- * Monadic Reduction-    , mapM_-    , forM_-    , msum-    -- * Applicative Reduction-    , traverse_-    , for_-    , asum-    -- * Logical Reduction-    , and-    , or-    , any-    , all-    -- * Monoidal Reduction-    , foldMap-    , fold-    , toList -    -- * List-Like Reduction-    , concatMap-    , elem-    , filter-    , filterWith-    , find-    , sum-    , product-    , notElem+    (      -- * List-Like Monoid Production-    , repeat+      repeat     , replicate     , cycle     -- * QuickCheck Properties     , prop_replicate_right_distributive     ) where -import Prelude hiding (mapM_, any, elem, filter, concatMap, and, or, all, sum, product, notElem, replicate, cycle, repeat)-import Control.Applicative+import Prelude hiding (replicate, cycle, repeat) import Control.Monad (MonadPlus)-import Data.Monoid.Generator-import Data.Monoid.Applicative-import Data.Monoid.Self-import Data.Monoid.Monad+import Data.Monoid.Reducer import Test.QuickCheck --- | Efficiently 'mapReduce' a 'Generator' using the 'Traversal' monoid. A specialized version of its namesake from "Data.Foldable"------ @---     'mapReduce' 'getTraversal'--- @-traverse_ :: (Generator c, Applicative f) => (Elem c -> f b) -> c -> f ()-traverse_ = mapReduceWith getTraversal-{-# INLINE traverse_ #-}-    --- | Convenience function as found in "Data.Foldable"------ @---     'flip' 'traverse_'--- @-for_ :: (Generator c, Applicative f) => c -> (Elem c -> f b) -> f ()-for_ = flip traverse_-{-# INLINE for_ #-} --- | The sum of a collection of actions, generalizing 'concat'------ @---    'reduceWith' 'getAlt'--- @ -asum :: (Generator c, Alternative f, f a ~ Elem c) => c -> f a-asum = reduceWith getAlt-{-# INLINE asum #-}---- | Efficiently 'mapReduce' a 'Generator' using the 'Action' monoid. A specialized version of its namesake from "Data.Foldable" and "Control.Monad"--- --- @---    'mapReduceWith' 'getAction'--- @ -mapM_ :: (Generator c, Monad m) => (Elem c -> m b) -> c -> m ()-mapM_ = mapReduceWith getAction-{-# INLINE mapM_ #-}---- | Convenience function as found in "Data.Foldable" and "Control.Monad"------ @---     'flip' 'mapM_'--- @-forM_ :: (Generator c, Monad m) => c -> (Elem c -> m b) -> m ()-forM_ = flip mapM_-{-# INLINE forM_ #-}---- | The sum of a collection of actions, generalizing 'concat'------ @---     'reduceWith' 'getMonadSum'--- @-msum :: (Generator c, MonadPlus m, m a ~ Elem c) => c -> m a-msum = reduceWith getMonadSum-{-# INLINE msum #-}---- | Efficiently 'mapReduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable"------ @---     'mapReduceWith' 'getSelf'--- @-foldMap :: (Monoid m, Generator c) => (Elem c -> m) -> c -> m-foldMap = mapReduceWith getSelf-{-# INLINE foldMap #-}---- | Type specialization of "foldMap" above-concatMap :: Generator c => (Elem c -> [b]) -> c -> [b]-concatMap = foldMap-{-# INLINE concatMap #-}---- | Efficiently 'reduce' a 'Generator' using the 'Self' monoid. A specialized version of its namesake from "Data.Foldable"------ @---     'reduceWith' 'getSelf'--- @-fold :: (Monoid m, Generator c, Elem c ~ m) => c -> m-fold = reduceWith getSelf-{-# INLINE fold #-}---- | Convert any 'Generator' to a list of its contents. Specialization of 'reduce'-toList :: Generator c => c -> [Elem c]-toList = reduce-{-# INLINE toList #-}---- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'------ @---     'reduceWith' 'getAll'--- @-and :: (Generator c, Elem c ~ Bool) => c -> Bool-and = reduceWith getAll-{-# INLINE and #-}---- | Efficiently 'reduce' a 'Generator' that contains values of type 'Bool'------ @---     'reduceWith' 'getAny'--- @-or :: (Generator c, Elem c ~ Bool) => c -> Bool-or = reduceWith getAny-{-# INLINE or #-}---- | Efficiently 'mapReduce' any 'Generator' checking to see if any of its values match the supplied predicate------ @---     'mapReduceWith' 'getAny'--- @-any :: Generator c => (Elem c -> Bool) -> c -> Bool-any = mapReduceWith getAny-{-# INLINE any #-}---- | Efficiently 'mapReduce' any 'Generator' checking to see if all of its values match the supplied predicate------ @---     'mapReduceWith' 'getAll'--- @-all :: Generator c => (Elem c -> Bool) -> c -> Bool-all = mapReduceWith getAll-{-# INLINE all #-}---- | Efficiently sum over the members of any 'Generator'------ @---     'reduceWith' 'getSum'--- @-sum :: (Generator c, Num (Elem c)) => c -> Elem c-sum = reduceWith getSum-{-# INLINE sum #-}---- | Efficiently take the product of every member of a 'Generator'------ @---     'reduceWith' 'getProduct'--- @-product :: (Generator c, Num (Elem c)) => c -> Elem c-product = reduceWith getProduct-{-# INLINE product #-}---- | Check to see if 'any' member of the 'Generator' matches the supplied value-elem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool-elem = any . (==)-{-# INLINE elem #-}---- | Check to make sure that the supplied value is not a member of the 'Generator'-notElem :: (Generator c, Eq (Elem c)) => Elem c -> c -> Bool-notElem x = not . elem x-{-# INLINE notElem #-}---- | Efficiently 'mapReduce' a subset of the elements in a 'Generator'-filter :: (Generator c, Elem c `Reducer` m) => (Elem c -> Bool) -> c -> m-filter p = foldMap f where-    f x | p x = unit x-        | otherwise = mempty-{-# INLINE filter #-}---- | Allows idiomatic specialization of filter by proving a function that will be used to transform the output-filterWith :: (Generator c, Elem c `Reducer` m) => (m -> n) -> (Elem c -> Bool) -> c -> n -filterWith f p = f . filter p-{-# INLINE filterWith #-}+-- | A generalization of 'Data.List.cycle' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids.+cycle :: Monoid m => m -> m+cycle xs = xs' where xs' = xs `mappend` xs' --- | A specialization of 'filter' using the 'First' 'Monoid', analogous to 'Data.List.find'------ @---     'filterWith' 'getFirst'--- @-find :: Generator c => (Elem c -> Bool) -> c -> Maybe (Elem c)-find = filterWith getFirst-{-# INLINE find #-}+-- | A generalization of 'Data.List.repeat' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids.+repeat :: (e `Reducer` m) => e -> m +repeat x = xs where xs = cons x xs   -- | A generalization of 'Data.List.replicate' to an arbitrary 'Monoid'. Adapted from  -- <http://augustss.blogspot.com/2008/07/lost-and-found-if-i-write-108-in.html>@@ -245,14 +57,6 @@             | y == 1 = x `mappend` z             | otherwise = g (x `mappend` x) ((y - 1) `quot` 2) (x `mappend` z) {-# INLINE replicate #-}---- | A generalization of 'Data.List.cycle' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids.-cycle :: Monoid m => m -> m-cycle xs = xs' where xs' = xs `mappend` xs'---- | A generalization of 'Data.List.repeat' to an arbitrary 'Monoid'. May fail to terminate for some values in some monoids.-repeat :: (e `Reducer` m) => e -> m -repeat x = xs where xs = cons x xs   prop_replicate_right_distributive :: (Eq m, Monoid m, Arbitrary m, Integral n) => m -> n -> n -> Bool prop_replicate_right_distributive m x y
Data/Monoid/FromString.hs view
@@ -20,7 +20,7 @@     ) where  import Control.Functor.Pointed-import Data.Monoid.Generator+import Data.Generator import Data.Monoid.Reducer import Data.Monoid.Instances () import GHC.Exts
− Data/Monoid/Generator.hs 
@@ -1,186 +0,0 @@-{-# LANGUAGE UndecidableInstances, TypeOperators, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances, TypeFamilies #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Monoid.Generator--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  portable------ A 'Generator' @c@ is a possibly-specialized container, which contains values of --- type 'Elem' @c@, and which knows how to efficiently apply a 'Reducer' to extract--- an answer.------ Since a 'Generator' is not polymorphic in its contents, it is more specialized--- than "Data.Foldable.Foldable", and a 'Reducer' may supply efficient left-to-right--- and right-to-left reduction strategies that a 'Generator' may avail itself of.--------------------------------------------------------------------------------module Data.Monoid.Generator-    ( module Data.Monoid.Reducer-    -- * Generators-    , Generator-    , Elem-    , mapReduce-    , mapTo-    , mapFrom-    -- * Generator Transformers-    , Keys(Keys, getKeys)-    , Values(Values, getValues)-    , Char8(Char8, getChar8)-    -- * Combinators-    , reduce-    , mapReduceWith-    , reduceWith-    ) where--import Data.Array -import Data.Word (Word8)-import Data.Text (Text)-import Data.Foldable (fold,foldMap)-import qualified Data.Text as Text-import qualified Data.ByteString as Strict (ByteString, foldl')-import qualified Data.ByteString.Char8 as Strict8 (foldl')-import qualified Data.ByteString.Lazy as Lazy (ByteString, toChunks)-import qualified Data.ByteString.Lazy.Char8 as Lazy8 (toChunks)-import qualified Data.Sequence as Seq-import Data.FingerTree (Measured, FingerTree)-import Data.Sequence (Seq)-import qualified Data.Set as Set-import Data.Set (Set)-import qualified Data.IntSet as IntSet-import Data.IntSet (IntSet)-import qualified Data.IntMap as IntMap-import Data.IntMap (IntMap)-import qualified Data.Map as Map-import Data.Map (Map)--import Control.Parallel.Strategies-import Data.Monoid.Reducer---- | minimal definition 'mapReduce' or 'mapTo'-class Generator c where-    type Elem c :: * -    mapReduce :: (e `Reducer` m) => (Elem c -> e) -> c -> m-    mapTo     :: (e `Reducer` m) => (Elem c -> e) -> m -> c -> m -    mapFrom   :: (e `Reducer` m) => (Elem c -> e) -> c -> m -> m--    mapReduce f = mapTo f mempty-    mapTo f m = mappend m . mapReduce f-    mapFrom f = mappend . mapReduce f--instance Generator Strict.ByteString where-    type Elem Strict.ByteString = Word8-    mapTo f = Strict.foldl' (\a -> snoc a . f)--instance Generator Lazy.ByteString where-    type Elem Lazy.ByteString = Word8-    mapReduce f = fold . parMap rwhnf (mapReduce f) . Lazy.toChunks--instance Generator Text where-    type Elem Text = Char-    mapTo f = Text.foldl' (\a -> snoc a . f)--instance Generator [c] where-    type Elem [c] = c-    mapReduce f = foldr (cons . f) mempty--instance Measured v e => Generator (FingerTree v e) where-    type Elem (FingerTree v e) = e-    mapReduce f = foldMap (unit . f)--instance Generator (Seq c) where-    type Elem (Seq c) = c-    mapReduce f = foldMap (unit . f)--instance Generator IntSet where-    type Elem IntSet = Int-    mapReduce f = mapReduce f . IntSet.toList--instance Generator (Set a) where-    type Elem (Set a) = a-    mapReduce f = mapReduce f . Set.toList--instance Generator (IntMap v) where-    type Elem (IntMap v) = (Int,v)-    mapReduce f = mapReduce f . IntMap.toList--instance Generator (Map k v) where-    type Elem (Map k v) = (k,v) -    mapReduce f = mapReduce f . Map.toList--instance Ix i => Generator (Array i e) where-    type Elem (Array i e) = (i,e)-    mapReduce f = mapReduce f . assocs---- | a 'Generator' transformer that asks only for the keys of an indexed container-newtype Keys c = Keys { getKeys :: c } --instance Generator (Keys (IntMap v)) where-    type Elem (Keys (IntMap v)) = Int-    mapReduce f = mapReduce f . IntMap.keys . getKeys--instance Generator (Keys (Map k v)) where-    type Elem (Keys (Map k v)) = k-    mapReduce f = mapReduce f . Map.keys . getKeys--instance Ix i => Generator (Keys (Array i e)) where-    type Elem (Keys (Array i e)) = i-    mapReduce f = mapReduce f . range . bounds . getKeys---- | a 'Generator' transformer that asks only for the values contained in an indexed container-newtype Values c = Values { getValues :: c } --instance Generator (Values (IntMap v)) where-    type Elem (Values (IntMap v)) = v-    mapReduce f = mapReduce f . IntMap.elems . getValues--instance Generator (Values (Map k v)) where-    type Elem (Values (Map k v)) = v-    mapReduce f = mapReduce f . Map.elems . getValues--instance Ix i => Generator (Values (Array i e)) where-    type Elem (Values (Array i e)) = e-    mapReduce f = mapReduce f . elems . getValues---- | a 'Generator' transformer that treats 'Word8' as 'Char'--- This lets you use a 'ByteString' as a 'Char' source without going through a 'Monoid' transformer like 'UTF8'-newtype Char8 c = Char8 { getChar8 :: c } --instance Generator (Char8 Strict.ByteString) where-    type Elem (Char8 Strict.ByteString) = Char-    mapTo f m = Strict8.foldl' (\a -> snoc a . f) m . getChar8--instance Generator (Char8 Lazy.ByteString) where-    type Elem (Char8 Lazy.ByteString) = Char-    mapReduce f = fold . parMap rwhnf (mapReduce f . Char8) . Lazy8.toChunks . getChar8---- | Apply a 'Reducer' directly to the elements of a 'Generator'-reduce :: (Generator c, Elem c `Reducer` m) => c -> m-reduce = mapReduce id-{-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Strict.ByteString -> m #-}-{-# SPECIALIZE reduce :: (Word8 `Reducer` m) => Lazy.ByteString -> m #-}-{-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Strict.ByteString -> m #-}-{-# SPECIALIZE reduce :: (Char `Reducer` m) => Char8 Lazy.ByteString -> m #-}-{-# SPECIALIZE reduce :: (c `Reducer` m) => [c] -> m #-}-{-# SPECIALIZE reduce :: (Generator (FingerTree v e), e `Reducer` m) => FingerTree v e -> m #-}-{-# SPECIALIZE reduce :: (Char `Reducer` m) => Text -> m #-}-{-# SPECIALIZE reduce :: (e `Reducer` m) => Seq e -> m #-}-{-# SPECIALIZE reduce :: (Int `Reducer` m) => IntSet -> m #-}-{-# SPECIALIZE reduce :: (a `Reducer` m) => Set a -> m #-}-{-# SPECIALIZE reduce :: ((Int,v) `Reducer` m) => IntMap v -> m #-}-{-# SPECIALIZE reduce :: ((k,v) `Reducer` m) => Map k v -> m #-}-{-# SPECIALIZE reduce :: (Int `Reducer` m) => Keys (IntMap v) -> m #-}-{-# SPECIALIZE reduce :: (k `Reducer` m) => Keys (Map k v) -> m #-}-{-# SPECIALIZE reduce :: (v `Reducer` m) => Values (IntMap v) -> m #-}-{-# SPECIALIZE reduce :: (v `Reducer` m) => Values (Map k v) -> m #-}--mapReduceWith :: (Generator c, e `Reducer` m) => (m -> n) -> (Elem c -> e) -> c -> n-mapReduceWith f g = f . mapReduce g-{-# INLINE mapReduceWith #-}--reduceWith :: (Generator c, Elem c `Reducer` m) => (m -> n) -> c -> n-reduceWith f = f . reduce-{-# INLINE reduceWith #-}
− Data/Monoid/Generator/Free.hs 
@@ -1,114 +0,0 @@-{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, ExistentialQuantification, TypeFamilies #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Monoid.Generator.Free--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  non-portable (MPTCs)-----------------------------------------------------------------------------------module Data.Monoid.Generator.Free-    ( module Data.Monoid.Generator-    , module Data.Monoid.Reducer-    , Free (AnyGenerator)-    ) where--import Control.Functor.Pointed-import Control.Monad-import Data.Monoid.Generator-import Data.Foldable-import Data.Monoid.Reducer-import Data.Monoid.Additive-import qualified Data.Monoid.Combinators as M-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) => AnyGenerator c--instance Eq a => Eq (Free a) where-    a == b = M.toList a == M.toList b-    a /= b = M.toList a == M.toList b--instance Ord a => Ord (Free a) where-    a <= b = M.toList a <= M.toList b-    a >= b = M.toList a >= M.toList b-    a < b  = M.toList a <  M.toList b-    a > b  = M.toList a >  M.toList b-    a `compare` b = M.toList a `compare` M.toList b--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 (AnyGenerator 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-    AnyGenerator c >>= k = getSelf (mapReduce k c)--instance MonadPlus Free where-    mzero = Empty-    mplus = Plus--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 (AnyGenerator c) = M.foldMap 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 (AnyGenerator c) = 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 (AnyGenerator c)   = 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 (AnyGenerator c) m = mapFrom f c m
− Data/Monoid/Generator/LZ78.hs 
@@ -1,114 +0,0 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Monoid.Generator.LZ78--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  portable------ Compression algorithms are all about exploiting redundancy. When applying--- an expensive 'Reducer' to a redundant source, it may be better to --- extract the structural redundancy that is present. 'LZ78' is a compression--- algorithm that does so, without requiring the dictionary to be populated--- with all of the possible values of a data type unlike its later --- refinement LZW, and which has fewer comparison reqirements during encoding--- than its earlier counterpart LZ77. Since we aren't storing these as a --- bitstream the LZSS refinement of only encoding pointers once you cross--- the break-even point is a net loss. ---------------------------------------------------------------------------------module Data.Monoid.Generator.LZ78 -    ( module Data.Monoid.Generator-    -- * Lempel-Ziv 78 -    , LZ78-    -- * Decoding-    , decode-    -- * Encoding-    , encode-    , encodeEq-    -- * QuickCheck Properties-    , 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.Foldable-import Data.Monoid.Self---- | An LZ78 compressing 'Generator', which supports efficient 'mapReduce' operations--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--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)---- | 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
− Data/Monoid/Generator/RLE.hs 
@@ -1,100 +0,0 @@-{-# LANGUAGE TypeFamilies, MultiParamTypeClasses, TypeOperators, FlexibleInstances, FlexibleContexts #-}---------------------------------------------------------------------------------- |--- Module      :  Data.Monoid.Generator.RLE--- Copyright   :  (c) Edward Kmett 2009--- License     :  BSD-style--- Maintainer  :  ekmett@gmail.com--- Stability   :  experimental--- Portability :  portable------ Compression algorithms are all about exploiting redundancy. When applying--- an expensive 'Reducer' to a redundant source, it may be better to --- extract the structural redundancy that is present. Run length encoding--- can do so for long runs of identical inputs.--------------------------------------------------------------------------------module Data.Monoid.Generator.RLE-    ( module Data.Monoid.Generator-    , RLE(RLE, getRLE)-    , Run(Run)-    , decode-    , encode-    , encodeList-    , prop_decode_encode-    , prop_decode_encodeList-    ) where--import qualified Data.Sequence as Seq-import Data.Sequence (Seq,(|>),(<|),ViewL(..),ViewR(..),(><),viewl,viewr)-import Data.Foldable-import Data.Monoid.Generator-import qualified Data.Monoid.Combinators as Monoid -import Control.Functor.Pointed---- | A single run with a strict length.-data Run a = Run a {-# UNPACK #-} !Int--instance Functor Run where-    fmap f (Run a n) = Run (f a) n--instance Pointed Run where-    point a = Run a 1---- | A 'Generator' which supports efficient 'mapReduce' operations over run-length encoded data.-newtype RLE f a = RLE { getRLE :: f (Run a) } --instance Functor f => Functor (RLE f) where-    fmap f = RLE . fmap (fmap f) . getRLE--instance Foldable f => Generator (RLE f a) where-    type Elem (RLE f a) = a-    mapReduce f = foldMap run . getRLE where-        run (Run a n) = unit (f a) `Monoid.replicate` n--decode :: Foldable f => RLE f a -> [a]-decode = reduce---- | naive left to right encoder--encodeList :: Eq a => [a] -> RLE [] a-encodeList [] = RLE []-encodeList (a:as) = RLE (point a `before` as)--before :: Eq a => Run a -> [a] -> [Run a]-r           `before` []                 = [r]-r@(Run a n) `before` (b:bs) | a == b    = Run a (n+1) `before` bs-                            | otherwise = r : point b `before` bs---- | QuickCheck property: decode . encode = id-prop_decode_encodeList :: Eq a => [a] -> Bool-prop_decode_encodeList xs = decode (encode xs) == xs---- One nice property that run-length encoding has is that it can be computed monoidally as follows--instance Eq a => Monoid (RLE Seq a) where-    mempty = RLE Seq.empty-    RLE l `mappend` RLE r = viewr l `merge` viewl r where-        (l' :> Run a m) `merge` (Run b n :< r')-            | a == b     = RLE ((l' |> Run a (m+n)) >< r')-            | otherwise  = RLE (l >< r)-        EmptyR `merge` _ = RLE r-        _ `merge` EmptyL = RLE l--instance Eq a => Reducer a (RLE Seq a) where-    unit = RLE . Seq.singleton . point-    cons a (RLE r) = case viewl r of-            Run b n :< r' | a == b    -> RLE (Run a (n+1) <| r')-                          | otherwise -> RLE (Run a 1     <| r )-            EmptyL                    -> RLE (return (point a))-    snoc (RLE l) a = case viewr l of-            l' :> Run b n | a == b    -> RLE (l' |> Run b (n+1))-                          | otherwise -> RLE (l  |> Run a 1    )-            EmptyR                    -> RLE (return (point a))--encode :: (Generator c, Eq (Elem c)) => c -> RLE Seq (Elem c)-encode = reduce--prop_decode_encode :: (Generator c, Eq (Elem c)) => c -> Bool-prop_decode_encode xs = decode (encode xs) == reduce xs
Data/Monoid/Lexical/SourcePosition.hs view
@@ -33,7 +33,7 @@ import Control.Functor.Extras import Control.Functor.Pointed import Data.Monoid.Reducer.Char-import Data.Monoid.Generator+import Data.Generator import Data.String
Data/Monoid/Lexical/Words.hs view
@@ -33,7 +33,7 @@ import Data.Char (isSpace) import Data.Maybe (maybeToList) import Data.Monoid.Reducer.Char-import Data.Monoid.Generator+import Data.Generator import Control.Functor.Pointed  -- | A 'CharReducer' transformer that breaks a 'Char' 'Generator' into distinct words, feeding a 'Char' 'Reducer' each line in turn
Data/Monoid/Monad.hs view
@@ -56,7 +56,7 @@  -- | A 'MonadSum' turns any 'MonadPlus' instance into a 'Monoid'. --   It also provides a 'Multiplicative' instance for a 'Monad' wrapped around a 'Monoid'---   and asserts that any 'MonadPlus' applied to a 'Monoid' forms a 'LeftSemiNearRing' +--   and asserts that any 'MonadPlus' applied to a 'Monoid' forms a 'RightSemiNearRing'  --   under these operations.  newtype MonadSum m a = MonadSum { getMonadSum :: m a } @@ -83,7 +83,7 @@ instance MonadPlus m => Reducer (m a) (MonadSum m a) where     unit = MonadSum -instance (MonadPlus m, Monoid a) => LeftSemiNearRing (MonadSum m a)+instance (MonadPlus m, Monoid a) => RightSemiNearRing (MonadSum m a)  -- | if @m@ is a 'Module' over @r@ and @f@ is a 'Monad' then @f `Mon` m@ is a 'Module' as well
Data/Monoid/Multiplicative.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, TypeOperators #-}  ----------------------------------------------------------------------------- -- |@@ -22,11 +22,11 @@ -- Any 'Monoid' can be turned into a 'Multiplicative' using the 'Exp' wrapper. -- -- Instances are supplied for common Monads of Monoids, in a fashion --- which can be extended if the 'Monad' is a 'MonadPlus' to yield a 'LeftSemiNearRing'+-- which can be extended if the 'Monad' is a 'MonadPlus' to yield a 'RightSemiNearRing' -- -- Instances are also supplied for common Applicatives of Monoids, in a -- fashion which can be extended if the 'Applicative' is 'Alternative' to--- yield a 'LeftSemiNearRing'+-- yield a 'RightSemiNearRing' -----------------------------------------------------------------------------  module Data.Monoid.Multiplicative @@ -65,7 +65,7 @@  import Data.Monoid.Additive import Data.Monoid.FromString-import Data.Monoid.Generator+import Data.Generator import Data.Monoid.Instances () import Data.Monoid.Self @@ -80,6 +80,14 @@     one :: m     times :: m -> m -> m +instance Multiplicative m => Multiplicative (Dual m) where+    one = Dual one+    Dual x `times` Dual y = Dual (y `times` x)++instance Multiplicative m => Multiplicative (m `ReducedBy` s) where+    one = Reduction one+    Reduction x `times` Reduction y = Reduction (x `times` y)+ -- | Convert a 'Multiplicative' into a 'Monoid'. Mnemonic: @Log a + Log b = Log (a * b)@ data Log m = Log { getLog :: m } @@ -222,13 +230,10 @@     one = pure undefined     times = liftA2 undefined - -- Numeric instances- instance Multiplicative Int where     one = 1     times = (*)-  instance Multiplicative Integer where     one = 1
Data/Monoid/Reducer.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving #-}+{-# LANGUAGE UndecidableInstances , FlexibleContexts , MultiParamTypeClasses , FlexibleInstances , GeneralizedNewtypeDeriving, TypeOperators, ScopedTypeVariables #-}  ----------------------------------------------------------------------------- -- |@@ -23,6 +23,7 @@     , foldReduce     , pureUnit     , returnUnit+    , ReducedBy(Reduction,getReduction)     ) where  import Control.Applicative@@ -46,6 +47,8 @@ import qualified Data.IntMap as IntMap import Data.IntMap (IntMap) +import Data.Reflection+ import qualified Data.Map as Map  import Data.Map (Map)@@ -191,3 +194,12 @@ instance Enum a => Reducer a (BitSet a) where     unit m = BitSet.insert m BitSet.empty -}++data (m `ReducedBy` s) = Reduction { getReduction :: m } ++instance Monoid m => Monoid (m `ReducedBy` s) where+    mempty = Reduction mempty+    Reduction a `mappend` Reduction b = Reduction (a `mappend` b)++instance (s `Reflects` (a -> m), Monoid m) => Reducer a (m `ReducedBy` s) where+    unit = Reduction . reflect (undefined :: s)
Data/Monoid/Self.hs view
@@ -25,7 +25,7 @@  import Control.Functor.Pointed import Data.Monoid.Reducer-import Data.Monoid.Generator+import Data.Generator  newtype Self m = Self { getSelf :: m } deriving (Monoid)
Data/Ring.hs view
@@ -1,6 +1,3 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}- ----------------------------------------------------------------------------- -- | -- Module      :  Data.Ring@@ -20,5 +17,12 @@  import Data.Group import Data.Ring.Semi+import Data.Monoid.Self+import Data.Monoid.FromString  class (Group a, SemiRing a) => Ring a++instance Ring r => Ring (Self r)+instance Ring r => Ring (FromString r)+instance Ring r => Ring (ReducedBy r s)+instance Ring r => Ring (Dual r)
+ Data/Ring/Algebra.hs view
@@ -0,0 +1,13 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}+module Data.Ring.Algebra+    ( module Data.Ring.Module+    , Algebra+    ) where++import Data.Ring.Module++-- |  +-- @r *. (x * y) = (r *. x) * y = x * (r *. y)@+--+-- @(x * y) .* r = y * (x .* r) = (y .* r) * x@+class (r `Module` m, Multiplicative m) => Algebra r m
Data/Ring/Module/AutomaticDifferentiation.hs view
@@ -1,60 +1,86 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, RankNTypes, FunctionalDependencies, UndecidableInstances, FlexibleContexts #-}++-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Ring.Module.AutomaticDifferentiation+-- Copyright   :  (c) Edward Kmett 2009+-- License     :  BSD-style+-- Maintainer  :  ekmett@gmail.com+-- Stability   :  experimental+-- Portability :  portable (instances use MPTCs)+--+-----------------------------------------------------------------------------+ module Data.Ring.Module.AutomaticDifferentiation      ( module Data.Ring.Module     , D+    , d+    , lift     ) where -import Prelude hiding ((*),(+),(-),subtract,negate)-import Data.Ring.Sugar+import Prelude import Data.Ring.Module import Data.Monoid.Reducer import Test.QuickCheck import Control.Monad -data D r m = D r m+data D s r m = D r m deriving (Show,Read) -instance (Monoid r, Monoid m) => Monoid (D r m) where+lift :: Monoid m => r -> D s r m+lift x = D x zero++infinitesimal :: (Monoid r, Multiplicative m) => D s r m+infinitesimal = D zero one++instance Eq r => Eq (D s r m) where+    D x _ == D y _ = x == y++instance Ord r => Ord (D s r m) where+    D x _ `compare` D y _ = compare x y++instance (Monoid r, Monoid m) => Monoid (D s r m) where     mempty = D mempty mempty-    D x m `mappend` D y n = D (x + y) (m + n)+    D x m `mappend` D y n = D (x `mappend` y) (m `mappend` n) -instance (Module r m) => Multiplicative (D r m) where+instance (r `Module` m) => Multiplicative (D s r m) where     one = D one zero-    D x m `times` D y n = D (x * y) (x *. n + m .* y)+    D x m `times` D y n = D (x `times` y) (x *. n `plus` m .* y) -instance (Group r, Module r m, Group m) => Group (D r m) where+instance (Group r, r `Module` m, Group m) => Group (D s r m) where     gnegate (D x m) = D (gnegate x) (gnegate m)     D x m `minus` D y n = D (x `minus` y) (m `minus` n)     D x m `gsubtract` D y n = D (x `gsubtract` y) (m `gsubtract` n) -instance (LeftSemiNearRing r, Module r m) => LeftSemiNearRing (D r m)-instance (RightSemiNearRing r, Module r m) => RightSemiNearRing (D r m)-instance (SemiRing r, Module r m) => SemiRing (D r m)-instance (Ring r, Module r m, Group m) => Ring (D r m)+instance Num a => Num (D s a a) where+    D x x' + D y y' = D (x + y) (x' + y')+    D x x' * D y y' = D (x * y) (x * y' + x' * y)+    D x x' - D y y' = D (x - y) (x' - y')+    negate (D x x') = D (negate x) (negate x')+    abs (D x x') = D (abs x) (signum x * x')+    signum (D x _) = D (signum x) 0+    fromInteger x = D (fromInteger x) 0 -instance (c `Reducer` r, c `Reducer` m) => Reducer c (D r m) where+instance Fractional a => Fractional (D s a a) where+    recip (D x x') = D (recip x) (-x'/x/x)+    fromRational x = D (fromRational x) 0++instance (LeftSemiNearRing r, Module r m) => LeftSemiNearRing (D s r m)+instance (RightSemiNearRing r, Module r m) => RightSemiNearRing (D s r m)+instance (SemiRing r, Module r m) => SemiRing (D s r m)+instance (Ring r, Module r m, Group m) => Ring (D s r m)++instance (c `Reducer` r, c `Reducer` m) => Reducer c (D s r m) where     unit c = D (unit c) (unit c)     c `cons` D x m = D (c `cons` x) (c `cons` m)     D x m `snoc` c = D (x `snoc` c) (m `snoc` c) -instance (Arbitrary r, Arbitrary m) => Arbitrary (D r m) where+instance (Arbitrary r, Arbitrary m) => Arbitrary (D s r m) where     arbitrary = liftM2 D arbitrary arbitrary     shrink (D r m) = liftM2 D (shrink r) (shrink m) -instance (CoArbitrary r, CoArbitrary m) => CoArbitrary (D r m) where+instance (CoArbitrary r, CoArbitrary m) => CoArbitrary (D s r m) where     coarbitrary (D r m) = coarbitrary r >< coarbitrary m -{---infix 0 ><--(><) :: Multiplicatve a => (a -> a) -> (AD a -> AD a) -> AD a -> AD a-(f >< f') a@(AD a0 a') = D (f a0) (a' * f' a)--data AD r = AD r (Maybe (AD r))--instance (Monoid r) => Monoid (AD r) where-    mempty = K mempty-    AD x m + AD y n = D (x + y) (m + n)+d :: (Monoid r, Multiplicative m) => (forall s. D s r m -> D s r m) -> (r,m)+d f = (y,y') where D y y' = f infinitesimal -instance (c `Reducer` r) => Reducer c (AD r) where-    unit c = c' where c' = AD (unit c) c'---}
Data/Ring/Semi.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE MultiParamTypeClasses #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Ring.Semi@@ -16,7 +17,14 @@     ) where  import Data.Ring.Semi.Near+import Data.Monoid.Self+import Data.Monoid.FromString  -- | A 'SemiRing' is an instance of both 'Multiplicative' and 'Monoid' where  --   'times' distributes over 'plus'. class (RightSemiNearRing a, LeftSemiNearRing a) => SemiRing a++instance SemiRing r => SemiRing (Self r)+instance SemiRing r => SemiRing (FromString r)+instance SemiRing r => SemiRing (ReducedBy r s)+instance SemiRing r => SemiRing (Dual r)
Data/Ring/Semi/Natural.hs view
@@ -35,8 +35,8 @@ import Data.Monoid.FromString import Data.Monoid.Lexical.SourcePosition import Data.Monoid.Lexical.UTF8.Decoder-import Data.Monoid.Generator.Free-import Data.Monoid.Generator.RLE+import Data.Generator.Free+import Data.Generator.Compressive.RLE import Data.Sequence (Seq)  natural :: Integer -> Natural
Data/Ring/Semi/Near.hs view
@@ -38,53 +38,57 @@ import Data.FingerTree import Data.Monoid.FromString import Data.Monoid.Self-import Data.Monoid.Generator+import Data.Generator  import qualified Data.Sequence as Seq import Data.Sequence (Seq)  import Text.Parsec.Prim --- | @(a + b) * c = (a * c) + (b * c)@-class (Multiplicative m, Monoid m) => RightSemiNearRing m ---- 'Monoid' transformers-instance RightSemiNearRing m => RightSemiNearRing (Self m)-instance RightSemiNearRing m => RightSemiNearRing (FromString m)- -- | @a * (b + c) = (a * b) + (a * c)@ class (Multiplicative m, Monoid m) => LeftSemiNearRing m   -- 'Monoid' transformers instance LeftSemiNearRing m => LeftSemiNearRing (Self m) instance LeftSemiNearRing m => LeftSemiNearRing (FromString m)+instance LeftSemiNearRing m => LeftSemiNearRing (ReducedBy m s)+instance RightSemiNearRing m => LeftSemiNearRing (Dual m) +-- | @(a + b) * c = (a * c) + (b * c)@+class (Multiplicative m, Monoid m) => RightSemiNearRing m ++-- 'Monoid' transformers+instance RightSemiNearRing m => RightSemiNearRing (Self m)+instance RightSemiNearRing m => RightSemiNearRing (FromString m)+instance RightSemiNearRing m => RightSemiNearRing (ReducedBy m s)+instance LeftSemiNearRing m => RightSemiNearRing (Dual m)+ -- non-'Monad' instances-instance (Measured v m, Monoid m) => LeftSemiNearRing (FingerTree v m)+instance (Measured v m, Monoid m) => RightSemiNearRing (FingerTree v m)  -- 'Monad' instances -- Every 'MonadPlus' over a 'Monoid' with an appropriate 'Multiplicative' instance--- for 'liftM2 mappend' is a 'LeftSemiNearRing' by 'MonadPlus' left-distributivity+-- for 'liftM2 mappend' is a 'RightSemiNearRing' by 'MonadPlus' left-distributivity -instance Monoid m => LeftSemiNearRing [m]+instance Monoid m => RightSemiNearRing [m] -instance Monoid m => LeftSemiNearRing (Maybe m)+instance Monoid m => RightSemiNearRing (Maybe m) -instance Monoid m => LeftSemiNearRing (Seq m)+instance Monoid m => RightSemiNearRing (Seq m) -instance (Stream s m t, Monoid a) => LeftSemiNearRing (ParsecT s u m a)+instance (Stream s m t, Monoid a) => RightSemiNearRing (ParsecT s u m a) -instance (MonadPlus m, Monoid n) => LeftSemiNearRing (SState.StateT s m n)+instance (MonadPlus m, Monoid n) => RightSemiNearRing (SState.StateT s m n) -instance (MonadPlus m, Monoid n) => LeftSemiNearRing (LState.StateT s m n)+instance (MonadPlus m, Monoid n) => RightSemiNearRing (LState.StateT s m n) -instance (MonadPlus m, Monoid n) => LeftSemiNearRing (ReaderT e m n)+instance (MonadPlus m, Monoid n) => RightSemiNearRing (ReaderT e m n) -instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (SRWS.RWST r w s m n)+instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (SRWS.RWST r w s m n) -instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (LRWS.RWST r w s m n)+instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (LRWS.RWST r w s m n) -instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (SWriter.WriterT w m n)+instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (SWriter.WriterT w m n) -instance (MonadPlus m, Monoid w, Monoid n) => LeftSemiNearRing (LWriter.WriterT w m n)+instance (MonadPlus m, Monoid w, Monoid n) => RightSemiNearRing (LWriter.WriterT w m n)
monoids.cabal view
@@ -1,5 +1,5 @@ name:		    monoids-version:	    0.1.21+version:	    0.1.25 license:	    BSD3 license-file:   LICENSE author:		    Edward A. Kmett@@ -30,8 +30,12 @@     array >= 0.2 && < 0.3,     reflection >= 0.1 && < 0.2   exposed-modules:+    Data.Field+    Data.Field.VectorSpace     Data.Group     Data.Group.Combinators+    Data.Group.Multiplicative+    Data.Group.Multiplicative.Sugar     Data.Group.Sugar     Data.Monoid.Additive     Data.Monoid.Additive.Sugar@@ -39,10 +43,11 @@     Data.Monoid.Categorical     Data.Monoid.Combinators     Data.Monoid.FromString-    Data.Monoid.Generator-    Data.Monoid.Generator.Free-    Data.Monoid.Generator.LZ78-    Data.Monoid.Generator.RLE+    Data.Generator+    Data.Generator.Combinators+    Data.Generator.Compressive.LZ78+    Data.Generator.Compressive.RLE+    Data.Generator.Free     Data.Monoid.Instances     Data.Monoid.Lexical.SourcePosition     Data.Monoid.Lexical.UTF8.Decoder@@ -57,6 +62,7 @@     Data.Monoid.Self     Data.Monoid.Union     Data.Ring+    Data.Ring.Algebra     Data.Ring.Boolean     Data.Ring.FromNum     Data.Ring.ModularArithmetic@@ -68,5 +74,5 @@     Data.Ring.Semi.Ord     Data.Ring.Semi.Tropical     Data.Ring.Sugar-    +   ghc-options: -Wall -fno-warn-duplicate-exports