[auto ekmett@gmail.com**20090329175512] { hunk ./doc/html/monoids/Data-Group-Combinators.html 22 ->monoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoidsmonoids-0.1.13: Lots of Monoidsmonoids-0.1.14: Lots of Monoids
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} hunk ./doc/html/monoids/src/Data-Ring-Boolean.html 33 - -newtype BoolRing = BoolRing { getBoolRing :: Bool } deriving (Eq,Ord,Show,Read) - -instance Monoid BoolRing where - mempty = BoolRing False - BoolRing a `mappend` BoolRing b = BoolRing ((a || b) && not (a && b)) - -instance Group BoolRing where - gnegate = BoolRing . not . getBoolRing - -instance Multiplicative BoolRing where - one = BoolRing True - BoolRing a `times` BoolRing b = BoolRing (a && b) - -instance LeftSemiNearRing BoolRing -instance RightSemiNearRing BoolRing -instance SemiRing BoolRing -instance Ring BoolRing - -instance Reducer Bool BoolRing where - unit = BoolRing +import Test.QuickCheck + +newtype BoolRing = BoolRing { getBoolRing :: Bool } deriving (Eq,Ord,Show,Read,Arbitrary,CoArbitrary) + +instance Monoid BoolRing where + mempty = BoolRing False + BoolRing a `mappend` BoolRing b = BoolRing ((a || b) && not (a && b)) + +instance Group BoolRing where + gnegate = BoolRing . not . getBoolRing + +instance Multiplicative BoolRing where + one = BoolRing True + BoolRing a `times` BoolRing b = BoolRing (a && b) + +instance LeftSemiNearRing BoolRing +instance RightSemiNearRing BoolRing +instance SemiRing BoolRing +instance Ring BoolRing + +instance Reducer Bool BoolRing where + unit = BoolRing hunk ./doc/html/monoids/src/Data-Ring-FromNum.html 32 - -newtype FromNum a = FromNum { getFromNum :: a } deriving (Eq,Show,Num) - -instance Num a => Monoid (FromNum a) where - mempty = fromInteger 0 - mappend = (+) - -instance Num a => Group (FromNum a) where - minus = (-) - gnegate = negate - -instance Num a => Multiplicative (FromNum a) where - one = fromInteger 1 - times = (*) - --- you can assume these, but you're probably lying to yourself -instance Num a => LeftSemiNearRing (FromNum a) -instance Num a => RightSemiNearRing (FromNum a) -instance Num a => SemiRing (FromNum a) -instance Num a => Ring (FromNum a) - -instance Num a => Reducer Integer (FromNum a) where - unit = fromInteger - +import Test.QuickCheck + +newtype FromNum a = FromNum { getFromNum :: a } deriving (Eq,Show,Num,Arbitrary,CoArbitrary) + +instance Num a => Monoid (FromNum a) where + mempty = fromInteger 0 + mappend = (+) + +instance Num a => Group (FromNum a) where + minus = (-) + gnegate = negate + +instance Num a => Multiplicative (FromNum a) where + one = fromInteger 1 + times = (*) + +-- you can assume these, but you're probably lying to yourself +instance Num a => LeftSemiNearRing (FromNum a) +instance Num a => RightSemiNearRing (FromNum a) +instance Num a => SemiRing (FromNum a) +instance Num a => Ring (FromNum a) + +instance Num a => Reducer Integer (FromNum a) where + unit = fromInteger + hunk ./doc/html/monoids/src/Data-Ring-Module-AutomaticDifferentiation.html 19 - -data D r m = D r m +import Test.QuickCheck +import Control.Monad hunk ./doc/html/monoids/src/Data-Ring-Module-AutomaticDifferentiation.html 22 -instance (Monoid r, Monoid m) => Monoid (D r m) where - mempty = D mempty mempty - D x m `mappend` D y n = D (x + y) (m + n) - -instance (Module r m) => Multiplicative (D r m) where - one = D one zero - D x m `times` D y n = D (x * y) (x *. n + m .* y) - -instance (Group r, Module r m, Group m) => Group (D 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 (c `Reducer` r, c `Reducer` m) => Reducer c (D 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) - -{-- -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 D r m = D r m + +instance (Monoid r, Monoid m) => Monoid (D r m) where + mempty = D mempty mempty + D x m `mappend` D y n = D (x + y) (m + n) + +instance (Module r m) => Multiplicative (D r m) where + one = D one zero + D x m `times` D y n = D (x * y) (x *. n + m .* y) + +instance (Group r, Module r m, Group m) => Group (D 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 (c `Reducer` r, c `Reducer` m) => Reducer c (D 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 + arbitrary = liftM2 D arbitrary arbitrary + shrink (D r m) = liftM2 D (shrink r) (shrink m) hunk ./doc/html/monoids/src/Data-Ring-Module-AutomaticDifferentiation.html 51 -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) +instance (CoArbitrary r, CoArbitrary m) => CoArbitrary (D r m) where + coarbitrary (D r m) = coarbitrary r >< coarbitrary m + +{-- +infix 0 >< hunk ./doc/html/monoids/src/Data-Ring-Module-AutomaticDifferentiation.html 57 -instance (c `Reducer` r) => Reducer c (AD r) where - unit c = c' where c' = AD (unit c) c' ---} +(><) :: 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) + +instance (c `Reducer` r) => Reducer c (AD r) where + unit c = c' where c' = AD (unit c) c' +--} hunk ./doc/html/monoids/src/Data-Ring-Semi-Ord.html 36 -newtype Order a = Order { getOrder :: a } deriving (Eq,Ord,Read,Show,Bounded,Arbitrary) +newtype Order a = Order { getOrder :: a } deriving (Eq,Ord,Read,Show,Bounded,Arbitrary,CoArbitrary) hunk ./doc/html/monoids/src/Data-Ring-Semi-Ord.html 92 - coarbitrary MinBound = variant 0 - coarbitrary (Priority a) = variant 1 . coarbitrary a - coarbitrary MaxBound = variant 2 + shrink (Priority x) = MinBound : MaxBound : fmap Priority (shrink x) + shrink MinBound = [] + shrink MaxBound = [] hunk ./doc/html/monoids/src/Data-Ring-Semi-Ord.html 96 -instance Ord a => Monoid (Priority a) where - mappend = max - mempty = minBound - -instance Ord a => Multiplicative (Priority a) where - times = min - one = maxBound - -instance Ord a => LeftSemiNearRing (Priority a) -instance Ord a => RightSemiNearRing (Priority a) -instance Ord a => SemiRing (Priority a) - -instance Ord a => Reducer a (Priority a) where - unit = Priority - -instance Ord a => Reducer (MinPriority a) (Priority a) where - unit (MinPriority Nothing) = MaxBound - unit (MinPriority (Just x)) = Priority x - -instance Ord a => Reducer (MaxPriority a) (Priority a) where - unit (MaxPriority Nothing) = MinBound - unit (MaxPriority (Just x)) = Priority x - -instance Functor Priority where - fmap _ MaxBound = MaxBound - fmap f (Priority a) = Priority (f a) - fmap _ MinBound = MinBound +instance CoArbitrary a => CoArbitrary (Priority a) where + coarbitrary MinBound = variant (0 :: Int) + coarbitrary (Priority a) = variant (1 :: Int) . coarbitrary a + coarbitrary MaxBound = variant (2 :: Int) + +instance Ord a => Monoid (Priority a) where + mappend = max + mempty = minBound + +instance Ord a => Multiplicative (Priority a) where + times = min + one = maxBound + +instance Ord a => LeftSemiNearRing (Priority a) +instance Ord a => RightSemiNearRing (Priority a) +instance Ord a => SemiRing (Priority a) + +instance Ord a => Reducer a (Priority a) where + unit = Priority + +instance Ord a => Reducer (MinPriority a) (Priority a) where + unit (MinPriority Nothing) = MaxBound + unit (MinPriority (Just x)) = Priority x + +instance Ord a => Reducer (MaxPriority a) (Priority a) where + unit (MaxPriority Nothing) = MinBound + unit (MaxPriority (Just x)) = Priority x hunk ./doc/html/monoids/src/Data-Ring-Semi-Ord.html 124 -instance Pointed Priority where - point = Priority +instance Functor Priority where + fmap _ MaxBound = MaxBound + fmap f (Priority a) = Priority (f a) + fmap _ MinBound = MinBound + +instance Pointed Priority where + point = Priority hunk ./doc/html/monoids/src/Data-Ring-Semi-Tropical.html 9 -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving #-} hunk ./doc/html/monoids/src/Data-Ring-Semi-Tropical.html 29 -import Control.Functor.Pointed -import Data.Monoid.Reducer (Reducer, unit, Monoid, mappend, mempty) -import Data.Ring.Semi -import Data.Monoid.Ord hiding (infinity) - -infinity :: Tropical a -infinity = Tropical Nothing - --- | The 'SemiRing' @('min','+')@ over @'a' extended with 'infinity'@. --- When @a@ has a Num instance with an addition that respects order, then this is --- transformed into a tropical semiring. It is assumed that 0 is the least element --- of a. --- --- <http://hal.archives-ouvertes.fr/docs/00/11/37/79/PDF/Tropical.pdf> - -newtype Tropical a = Tropical { getTropical :: Maybe a } deriving (Eq,Show,Read) - -instance Ord a => Ord (Tropical a) where - Tropical Nothing `compare` Tropical Nothing = EQ - Tropical Nothing `compare` _ = GT - _ `compare` Tropical Nothing = LT - Tropical (Just a) `compare` Tropical (Just b) = a `compare` b - -instance Ord a => Monoid (Tropical a) where - mempty = infinity - mappend = min - -instance Ord a => Reducer a (Tropical a) where - unit = Tropical . Just - -instance Ord a => Reducer (Maybe a) (Tropical a) where - unit = Tropical - -instance Ord a => Reducer (MinPriority a) (Tropical a) where - unit = Tropical . getMinPriority - -instance Functor Tropical where - fmap f (Tropical a) = Tropical (fmap f a) - -instance Pointed Tropical where - point = Tropical . Just - -instance Num a => Multiplicative (Tropical a) where - one = point $ fromInteger 0 - Tropical Nothing `times` _ = infinity - Tropical (Just a) `times` Tropical (Just b) = point (a + b) - _ `times` Tropical Nothing = infinity - -instance (Ord a, Num a) => LeftSemiNearRing (Tropical a) -instance (Ord a, Num a) => RightSemiNearRing (Tropical a) -instance (Ord a, Num a) => SemiRing (Tropical a) +import Test.QuickCheck +import Control.Functor.Pointed +import Data.Monoid.Reducer (Reducer, unit, Monoid, mappend, mempty) +import Data.Ring.Semi +import Data.Monoid.Ord hiding (infinity) + +infinity :: Tropical a +infinity = Tropical Nothing + +-- | The 'SemiRing' @('min','+')@ over @'a' extended with 'infinity'@. +-- When @a@ has a Num instance with an addition that respects order, then this is +-- transformed into a tropical semiring. It is assumed that 0 is the least element +-- of a. +-- +-- <http://hal.archives-ouvertes.fr/docs/00/11/37/79/PDF/Tropical.pdf> + +newtype Tropical a = Tropical { getTropical :: Maybe a } + deriving (Eq,Show,Read,Arbitrary,CoArbitrary) + +instance Ord a => Ord (Tropical a) where + Tropical Nothing `compare` Tropical Nothing = EQ + Tropical Nothing `compare` _ = GT + _ `compare` Tropical Nothing = LT + Tropical (Just a) `compare` Tropical (Just b) = a `compare` b + +instance Ord a => Monoid (Tropical a) where + mempty = infinity + mappend = min + +instance Ord a => Reducer a (Tropical a) where + unit = Tropical . Just + +instance Ord a => Reducer (Maybe a) (Tropical a) where + unit = Tropical + +instance Ord a => Reducer (MinPriority a) (Tropical a) where + unit = Tropical . getMinPriority + +instance Functor Tropical where + fmap f (Tropical a) = Tropical (fmap f a) + +instance Pointed Tropical where + point = Tropical . Just + +instance Num a => Multiplicative (Tropical a) where + one = point $ fromInteger 0 + Tropical Nothing `times` _ = infinity + Tropical (Just a) `times` Tropical (Just b) = point (a + b) + _ `times` Tropical Nothing = infinity + +instance (Ord a, Num a) => LeftSemiNearRing (Tropical a) +instance (Ord a, Num a) => RightSemiNearRing (Tropical a) +instance (Ord a, Num a) => SemiRing (Tropical a) }