packages feed

semirings 0.2.1.1 → 0.3.0.0

raw patch · 5 files changed

+288/−102 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (Data.Semigroup.Internal.Product a)
- Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (Data.Semigroup.Internal.Sum a)
- Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (Data.Semigroup.Max a)
- Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (Data.Semigroup.Min a)
- Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (GHC.Base.Maybe a)
- Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Semigroup.Internal.Product a)
- Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Semigroup.Internal.Sum a)
- Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Semigroup.Max a)
- Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Semigroup.Min a)
- Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Semiring.Add a)
- Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Semiring.Mul a)
- Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (GHC.Base.Maybe a)
+ Data.Semiring: IntMapOf :: IntMap v -> IntMapOf k v
+ Data.Semiring: IntSetOf :: IntSet -> IntSetOf a
+ Data.Semiring: [getIntMap] :: IntMapOf k v -> IntMap v
+ Data.Semiring: [getIntSet] :: IntSetOf a -> IntSet
+ Data.Semiring: instance (Data.Semiring.Ring a, GHC.Base.Applicative f) => Data.Semiring.Ring (Data.Monoid.Ap f a)
+ Data.Semiring: instance (Data.Semiring.Semiring a, GHC.Base.Applicative f) => Data.Semiring.Semiring (Data.Monoid.Ap f a)
+ Data.Semiring: instance (GHC.Types.Coercible GHC.Types.Int a, GHC.Base.Monoid a) => Data.Semiring.Semiring (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance (GHC.Types.Coercible GHC.Types.Int k, GHC.Base.Monoid k, Data.Semiring.Semiring v) => Data.Semiring.Semiring (Data.Semiring.IntMapOf k v)
+ Data.Semiring: instance Data.Semiring.Ring (Data.Functor.Contravariant.Predicate a)
+ Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (Data.Functor.Contravariant.Equivalence a)
+ Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (Data.Functor.Contravariant.Op a b)
+ Data.Semiring: instance Data.Semiring.Ring a => Data.Semiring.Ring (GHC.Maybe.Maybe a)
+ Data.Semiring: instance Data.Semiring.Semiring (Data.Functor.Contravariant.Predicate a)
+ Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Functor.Contravariant.Equivalence a)
+ Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Functor.Contravariant.Op a b)
+ Data.Semiring: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (GHC.Maybe.Maybe a)
+ Data.Semiring: instance GHC.Base.Monoid (Data.Semiring.IntMapOf k v)
+ Data.Semiring: instance GHC.Base.Monoid (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance GHC.Base.Semigroup (Data.Semiring.IntMapOf k v)
+ Data.Semiring: instance GHC.Base.Semigroup (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance GHC.Classes.Eq (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance GHC.Classes.Eq v => GHC.Classes.Eq (Data.Semiring.IntMapOf k v)
+ Data.Semiring: instance GHC.Classes.Ord (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance GHC.Classes.Ord v => GHC.Classes.Ord (Data.Semiring.IntMapOf k v)
+ Data.Semiring: instance GHC.Generics.Generic (Data.Semiring.IntMapOf k v)
+ Data.Semiring: instance GHC.Generics.Generic (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance GHC.Generics.Generic1 (Data.Semiring.IntMapOf k)
+ Data.Semiring: instance GHC.Generics.Generic1 Data.Semiring.IntSetOf
+ Data.Semiring: instance GHC.Read.Read (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance GHC.Read.Read v => GHC.Read.Read (Data.Semiring.IntMapOf k v)
+ Data.Semiring: instance GHC.Show.Show (Data.Semiring.IntSetOf a)
+ Data.Semiring: instance GHC.Show.Show v => GHC.Show.Show (Data.Semiring.IntMapOf k v)
+ Data.Semiring: newtype IntMapOf k v
+ Data.Semiring: newtype IntSetOf a
+ Data.Semiring.Generic: GenericSemiring :: a -> GenericSemiring a
+ Data.Semiring.Generic: instance Data.Semiring.Semiring a => Data.Semiring.Semiring (Data.Semiring.Generic.GenericSemiring a)
+ Data.Semiring.Generic: instance GHC.Generics.Generic (Data.Semiring.Generic.GenericSemiring a)
+ Data.Semiring.Generic: newtype GenericSemiring a

Files

CHANGELOG.md view
@@ -1,7 +1,22 @@-0.2.1.1: [2018.XX.XX]+0.3.0.0: [2019.01.01] ---------------------+* Rename the test suite to make `stack` happy.+* Clarified documentation. See #26.+* Simplify implementation of `^`. See #24.+* Add 'GenericSemiring', a newtype wrapper meant to be used with `-XDerivingVia`,+  helping avoid '-XDefaultSignatures'.+* Add newtypes for `IntSet` and `IntMap`.+* Remove `Semiring` and `Ring` instances for `Product` and `Sum`.+* Make `sum` and `product` more efficient for base>=4.7++0.2.1.1: [2018.10.01]+--------------------- * Fixed build on GHC-7.4 * Provide `Semiring` and `Ring` for an arbitrary `Num` via `WrappedNum` newtype.+* Make note of `Semiring` semantics for `Vector` and `[]` in the documentation.+* Require build script to ensure `semirings` builds with GHC-8.4.3 and GHC-8.6.1+* Fixed unlawful behaviour of `[]` `Semiring` instance.+* Improve performance of `^`.  0.2.1.0: [2018.09.26] ---------------------@@ -11,7 +26,7 @@ 0.2.0.1: [2018.07.28] --------------------- * Add instances for `Op`, `Equivalence`, `Comparison`, and `Predicate` from Data.Functor.Contravariant (upcoming base 4.12.0.0)-* docfix for (prod -> product, prod' -> product')+* docfix for (prod -> product, prod' -> product') change that occured in version 0.2.0.0.  0.2.0.0: [2018.07.23] ---------------------
Data/Semiring.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE DeriveFunctor              #-} {-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE DeriveTraversable          #-}+{-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE NoImplicitPrelude          #-} {-# LANGUAGE Rank2Types                 #-}@@ -15,7 +16,7 @@  ----------------------------------------------------------------------------- -- |--- A class for semirings (types with two binary operations, one commutative and one associative, and two respective identites), with various general-purpose instances.+-- A class for semirings (types with two binary operations, one commutative and one associative, and two respective identities), with various general-purpose instances. -- ----------------------------------------------------------------------------- @@ -36,19 +37,24 @@   , Add(..)   , Mul(..)   , WrappedNum(..)+  , IntSetOf(..)+  , IntMapOf(..) -    -- * Ring typeclass +    -- * Ring typeclass   , Ring(..)   , (-)-  , minus -  ) where +  , minus+  ) where  import           Control.Applicative (Applicative(..), Const(..), liftA2) import           Data.Bool (Bool(..), (||), (&&), otherwise, not)+#if MIN_VERSION_base(4,7,0)+import           Data.Coerce (Coercible, coerce)+#endif import           Data.Complex (Complex(..)) import           Data.Eq (Eq(..)) import           Data.Fixed (Fixed, HasResolution)-import           Data.Foldable (Foldable)+import           Data.Foldable (Foldable(foldMap)) import qualified Data.Foldable as Foldable import           Data.Function ((.), const, flip, id) import           Data.Functor (Functor(..))@@ -70,21 +76,21 @@ import           Data.Monoid (Ap(..)) #endif #if defined(VERSION_containers)---import           Data.IntMap (IntMap)---import qualified Data.IntMap as IntMap---import           Data.IntSet (IntSet)---import qualified Data.IntSet as IntSet+import           Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import           Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet import           Data.Map (Map) import qualified Data.Map as Map #endif-import           Data.Monoid (Monoid(..),Dual(..), Product(..), Sum(..))+import           Data.Monoid (Monoid(..), Dual(..)) import           Data.Ord (Ord(..), Ordering(..), compare) #if MIN_VERSION_base(4,6,0) import           Data.Ord (Down(..)) #endif import           Data.Proxy (Proxy(..)) import           Data.Ratio (Ratio, Rational, (%))-import           Data.Semigroup (Semigroup(..),Max(..), Min(..))+import           Data.Semigroup (Semigroup(..)) #if defined(VERSION_containers) import           Data.Set (Set) import qualified Data.Set as Set@@ -121,7 +127,7 @@ import           GHC.Integer (Integer) import qualified GHC.Num as Num import           GHC.Read (Read)-import           GHC.Real (Integral, Fractional, Real, RealFrac, quot, even)+import           GHC.Real (Integral, Fractional, Real, RealFrac) import           GHC.Show (Show) import           Numeric.Natural (Natural) import           System.Posix.Types@@ -139,19 +145,59 @@  -- | Raise a number to a non-negative integral power. -- If the power is negative, this will return 'zero'.+{-# SPECIALISE [1] (^) ::+        Integer -> Integer -> Integer,+        Integer -> Int -> Integer,+        Int -> Int -> Int #-}+{-# INLINABLE [1] (^) #-} -- See note [Inlining (^)] (^) :: (Semiring a, Integral b) => a -> b -> a-x0 ^ y0 | y0 < 0  = zero-        | y0 == 0 = one-        | otherwise = f x0 y0-  where-    f x y | even y = f (x * x) (y `quot` 2)-          | y == 1 = x-          | otherwise = g (x * x) (y `quot` 2) x-    g x y z | even y = g (x * x) (y `quot` 2) z-            | y == 1 = x * z-            | otherwise = g (x * x) (y `quot` 2) (x * z)-{-# INLINE (^) #-}+x ^ y = getMul (stimes y (Mul x)) +{- Note [Inlining (^)]+   ~~~~~~~~~~~~~~~~~~~+   The INLINABLE pragma allows (^) to be specialised at its call sites.+   If it is called repeatedly at the same type, that can make a huge+   difference, because of those constants which can be repeatedly+   calculated.++   Currently the fromInteger calls are not floated because we get+             \d1 d2 x y -> blah+   after the gentle round of simplification.+-}++{- Rules for powers with known small exponent+    see Trac #5237+    For small exponents, (^) is inefficient compared to manually+    expanding the multiplication tree.+    Here, rules for the most common exponent types are given.+    The range of exponents for which rules are given is quite+    arbitrary and kept small to not unduly increase the number of rules.+    It might be desirable to have corresponding rules also for+    exponents of other types (e.g., Word), but it's doubtful they+    would fire, since the exponents of other types tend to get+    floated out before the rule has a chance to fire. (Why?)++    Note: Trying to save multiplication by sharing the square for+    exponents 4 and 5 does not save time, indeed, for Double, it is+    up to twice slower, so the rules contain flat sequences of+    multiplications.+-}++{-# RULES+"^0/Int" forall x. x ^ (0 :: Int) = one+"^1/Int" forall x. x ^ (1 :: Int) = let u = x in u+"^2/Int" forall x. x ^ (2 :: Int) = let u = x in u*u+"^3/Int" forall x. x ^ (3 :: Int) = let u = x in u*u*u+"^4/Int" forall x. x ^ (4 :: Int) = let u = x in u*u*u*u+"^5/Int" forall x. x ^ (5 :: Int) = let u = x in u*u*u*u*u+"^0/Integer" forall x. x ^ (0 :: Integer) = one+"^1/Integer" forall x. x ^ (1 :: Integer) = let u = x in u+"^2/Integer" forall x. x ^ (2 :: Integer) = let u = x in u*u+"^3/Integer" forall x. x ^ (3 :: Integer) = let u = x in u*u*u+"^4/Integer" forall x. x ^ (4 :: Integer) = let u = x in u*u*u*u+"^5/Integer" forall x. x ^ (5 :: Integer) = let u = x in u*u*u*u*u+  #-}+ -- | Infix shorthand for 'plus'. (+) :: Semiring a => a -> a -> a (+) = plus@@ -179,18 +225,39 @@ foldMapT f = Foldable.foldr (times . f) one {-# INLINE foldMapT #-} +#if MIN_VERSION_base(4,7,0)+infixr 9 #.+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c+(#.) _ = coerce+ -- | The 'sum' function computes the additive sum of the elements in a structure. --   This function is lazy. For a strict version, see 'sum''.-sum  :: (Foldable t, Semiring a) => t a -> a-sum  = Foldable.foldr plus zero+sum :: (Foldable t, Semiring a) => t a -> a+sum = getAdd #. foldMap Add {-# INLINE sum #-}  -- | The 'product' function computes the product of the elements in a structure. --   This function is lazy. for a strict version, see 'product''. product :: (Foldable t, Semiring a) => t a -> a-product = Foldable.foldr times one+product = getMul #. foldMap Mul {-# INLINE product #-} +#else++-- | The 'sum' function computes the additive sum of the elements in a structure.+--   This function is lazy. For a strict version, see 'sum''.+sum :: (Foldable t, Semiring a) => t a -> a+sum = getAdd . foldMap Add+{-# INLINE sum #-}++-- | The 'product' function computes the product of the elements in a structure.+--   This function is lazy. for a strict version, see 'product''.+product :: (Foldable t, Semiring a) => t a -> a+product = getMul . foldMap Mul+{-# INLINE product #-}++#endif+ -- | The 'sum'' function computes the additive sum of the elements in a structure. --   This function is strict. For a lazy version, see 'sum'. sum'  :: (Foldable t, Semiring a) => t a -> a@@ -222,7 +289,6 @@     , Read     , Real     , RealFrac-    , Semiring     , Show     , Storable     , Traversable@@ -230,7 +296,7 @@     )  instance Semiring a => Semigroup (Add a) where-  (<>) = (+)+  Add a <> Add b = Add (a + b)   {-# INLINE (<>) #-}  instance Semiring a => Monoid (Add a) where@@ -258,7 +324,6 @@     , Read     , Real     , RealFrac-    , Semiring     , Show     , Storable     , Traversable@@ -266,7 +331,7 @@     )  instance Semiring a => Semigroup (Mul a) where-  (<>) = (*)+  Mul a <> Mul b = Mul (a * b)   {-# INLINE (<>) #-}  instance Semiring a => Monoid (Mul a) where@@ -315,40 +380,35 @@ -- | The class of semirings (types with two binary -- operations and two respective identities). One -- can think of a semiring as two monoids of the same--- underlying type: A commutative monoid and an--- associative monoid. For any type R with a 'Prelude.Num'--- instance, the commutative monoid is (R, '(Prelude.+)', 0)--- and the associative monoid is (R, '(Prelude.*)', 1).+-- underlying type, with the first being commutative.+-- In the documentation, you will often see the first+-- monoid being referred to as 'additive', and the second+-- monoid being referred to as 'multiplicative', a typical+-- convention when talking about semirings. --+-- For any type R with a 'Prelude.Num'+-- instance, the additive monoid is (R, '(Prelude.+)', 0)+-- and the multiplicative monoid is (R, '(Prelude.*)', 1).+--+-- For 'Prelude.Bool', the additive monoid is ('Prelude.Bool', 'Prelude.||', 'Prelude.False')+-- and the multiplicative monoid is ('Prelude.Bool', 'Prelude.&&', 'Prelude.True').+-- -- Instances should satisfy the following laws: -- -- [/additive identity/]---  --     @x '+' 'zero' = 'zero' '+' x = x@---  -- [/additive associativity/]---  --     @x '+' (y '+' z) = (x '+' y) '+' z@--- -- [/additive commutativity/]---      --     @x '+' y = y '+' x@--- -- [/multiplicative identity/]---  --     @x '*' 'one' = 'one' '*' x = x@--- -- [/multiplicative associativity/]--- --     @x '*' (y '*' z) = (x '*' y) '*' z@---  -- [/left- and right-distributivity of '*' over '+'/]--- --     @x '*' (y '+' z) = (x '*' y) '+' (x '*' z)@ --     @(x '+' y) '*' z = (x '*' z) '+' (y '*' z)@--- -- [/annihilation/]--- --     @'zero' '*' x = x '*' 'zero' = 'zero'@  class Semiring a where@@ -370,7 +430,7 @@ #endif   negate :: a -> a --- | Substract two 'Ring' values. For any type 'R' with+-- | Subtract two 'Ring' values. For any type 'R' with -- a 'Prelude.Num' instance, this is the same as '(Prelude.-)'. -- --     @x `minus` y = x '+' 'negate' y@@@ -434,12 +494,21 @@   negate = not   {-# INLINE negate #-} --- See Section: List fusion+-- | The 'Semiring' instance for '[a]' can be interpreted as+--   treating each element of the list as coefficients to a+--   polynomial in one variable.+--+-- ==== __Examples__+--+-- @poly1 = [1,2,3] :: [Int]@+-- @poly2 = [  2,1] :: [Int]@+-- @poly1 * poly2 = [2,5,8,3]@+-- fromList [2,5,8,3] instance Semiring a => Semiring [a] where   zero = []   one  = [one]-  plus  = listAdd-  times = listTimes+  plus  = listAdd -- See Section: List fusion+  times = listTimes -- See Section: List fusion   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}@@ -560,6 +629,10 @@ ;  one   = 1                      \ ;  plus  x y = (Num.+) x y        \ ;  times x y = (Num.*) x y        \+;  {-# INLINE zero #-}            \+;  {-# INLINE one  #-}            \+;  {-# INLINE plus #-}            \+;  {-# INLINE times #-}           \ }  deriveSemiring(Int)@@ -618,7 +691,7 @@ deriveSemiring(CDev) deriveSemiring(Natural) instance Integral a => Semiring (Ratio a) where-  {-# SPECIALIZE instance Semiring Rational #-} +  {-# SPECIALIZE instance Semiring Rational #-}   zero  = 0 % 1   one   = 1 % 1   plus  = (Num.+)@@ -627,14 +700,10 @@   {-# INLINE one   #-}   {-# INLINE plus  #-}   {-# INLINE times #-}-deriving instance Semiring a => Semiring (Product a)-deriving instance Semiring a => Semiring (Sum a) deriving instance Semiring a => Semiring (Identity a) #if MIN_VERSION_base(4,6,0) deriving instance Semiring a => Semiring (Down a) #endif-deriving instance Semiring a => Semiring (Max a)-deriving instance Semiring a => Semiring (Min a) instance HasResolution a => Semiring (Fixed a) where   zero  = 0   one   = 1@@ -648,6 +717,7 @@ #define deriveRing(ty)          \ instance Ring (ty) where {      \   negate = Num.negate           \+; {-# INLINE negate #-}         \ }  deriveRing(Int)@@ -712,11 +782,7 @@ #if MIN_VERSION_base(4,6,0) deriving instance Ring a => Ring (Down a) #endif-deriving instance Ring a => Ring (Product a)-deriving instance Ring a => Ring (Sum a) deriving instance Ring a => Ring (Identity a)-deriving instance Ring a => Ring (Max a)-deriving instance Ring a => Ring (Min a) instance HasResolution a => Ring (Fixed a) where   negate = Num.negate   {-# INLINE negate #-}@@ -729,7 +795,7 @@  -- | The multiplication laws are satisfied for --   any underlying 'Monoid', so we require a---   'Monoid' contraint instead of a 'Semiring'+--   'Monoid' constraint instead of a 'Semiring' --   constraint since 'times' can use --   the context of either. instance (Ord a, Monoid a) => Semiring (Set a) where@@ -742,9 +808,44 @@   {-# INLINE times #-}   {-# INLINE one   #-} +-- | Wrapper to mimic 'Set' ('Data.Semigroup.Sum' 'Int'),+-- 'Set' ('Data.Semigroup.Product' 'Int'), etc.,+-- while having a more efficient underlying representation.+newtype IntSetOf a = IntSetOf { getIntSet :: IntSet }+  deriving+    ( Eq+#if MIN_VERSION_base(4,6,1)+    , Generic+    , Generic1+#endif+    , Ord+    , Read+    , Show+    , Typeable+    , Semigroup+    , Monoid+    )++#if MIN_VERSION_base(4,7,0)+instance (Coercible Int a, Monoid a) => Semiring (IntSetOf a) where+  zero  = coerce IntSet.empty+  one   = coerce IntSet.singleton (mempty :: a)+  plus  = coerce IntSet.union+  xs `times` ys+    = coerce IntSet.fromList+        [ mappend k l+        | k :: a <- coerce IntSet.toList xs+        , l :: a <- coerce IntSet.toList ys+        ]+  {-# INLINE plus  #-}+  {-# INLINE zero  #-}+  {-# INLINE times #-}+  {-# INLINE one   #-}+#endif+ -- | The multiplication laws are satisfied for --   any underlying 'Monoid' as the key type,---   so we require a 'Monoid' contraint instead of+--   so we require a 'Monoid' constraint instead of --   a 'Semiring' constraint since 'times' can use --   the context of either. instance (Ord k, Monoid k, Semiring v) => Semiring (Map k v) where@@ -762,37 +863,43 @@   {-# INLINE times #-}   {-# INLINE one   #-} ---newtype IntSetP = IntSetP { intSetP :: IntSet }---newtype IntSetT = IntSetT { intSetT :: IntSet }------instance Semiring IntSetP where---  zero = IntSetP (IntSet.empty)---  one  = IntSetP (IntSet.singleton zero)---  plus (IntSetP x) (IntSetP y) = IntSetP (IntSet.union x y)---  times (IntSetP xs) (IntSetP ys) = IntSetP (foldMapIntSet (flip IntSet.map ys . plus) xs)------instance Semiring IntSetT where---  zero = IntSetT IntSet.empty---  one  = IntSetT (IntSet.singleton one)---  plus (IntSetT x) (IntSetT y) = IntSetT (IntSet.union x y)---  times (IntSetT xs) (IntSetT ys) = IntSetT (foldMapIntSet (flip IntSet.map ys . times) xs)------foldMapIntSet :: Monoid m => (Int -> m) -> IntSet -> m---foldMapIntSet f = IntSet.foldl' (flip (mappend . f)) mempty---{-# INLINE foldMapIntSet #-}+-- | Wrapper to mimic 'Map' ('Data.Semigroup.Sum' 'Int') v,+-- 'Map' ('Data.Semigroup.Product' 'Int') v, etc.,+-- while having a more efficient underlying representation.+newtype IntMapOf k v = IntMapOf { getIntMap :: IntMap v }+  deriving+    ( Eq+#if MIN_VERSION_base(4,6,1)+    , Generic+    , Generic1+#endif+    , Ord+    , Read+    , Show+    , Typeable+    , Semigroup+    , Monoid+    ) ---instance (Semiring a) => Semiring (IntMap a) where---  zero = IntMap.empty---  one  = IntMap.singleton zero one---  plus = IntMap.unionWith (+)---  xs `times` ys---    = IntMap.fromListWith (+)---        [ (plus k l, v * u)---        | (k,v) <- IntMap.toList xs---        , (l,u) <- IntMap.toList ys---        ]+#if MIN_VERSION_base(4,7,0)+instance (Coercible Int k, Monoid k, Semiring v) => Semiring (IntMapOf k v) where+  zero = coerce (IntMap.empty :: IntMap v)+  one  = coerce (IntMap.singleton :: Int -> v -> IntMap v) (mempty :: k) (one :: v)+  plus = coerce (IntMap.unionWith (+) :: IntMap v -> IntMap v -> IntMap v)+  xs `times` ys+    = coerce (IntMap.fromListWith (+) :: [(Int, v)] -> IntMap v)+        [ (mappend k l, v * u)+        | (k :: k, v :: v) <- coerce (IntMap.toList :: IntMap v -> [(Int, v)]) xs+        , (l :: k, u :: v) <- coerce (IntMap.toList :: IntMap v -> [(Int, v)]) ys+        ]+  {-# INLINE plus  #-}+  {-# INLINE zero  #-}+  {-# INLINE times #-}+  {-# INLINE one   #-} #endif +#endif+ {--------------------------------------------------------------------   Instances (unordered-containers) --------------------------------------------------------------------}@@ -801,7 +908,7 @@  -- | The multiplication laws are satisfied for --   any underlying 'Monoid', so we require a---   'Monoid' contraint instead of a 'Semiring'+--   'Monoid' constraint instead of a 'Semiring' --   constraint since 'times' can use --   the context of either. instance (Eq a, Hashable a, Monoid a) => Semiring (HashSet a) where@@ -816,7 +923,7 @@  -- | The multiplication laws are satisfied for --   any underlying 'Monoid' as the key type,---   so we require a 'Monoid' contraint instead of+--   so we require a 'Monoid' constraint instead of --   a 'Semiring' constraint since 'times' can use --   the context of either. instance (Eq k, Hashable k, Monoid k, Semiring v) => Semiring (HashMap k v) where@@ -842,7 +949,7 @@ #if defined(VERSION_primitive) -- | The multiplication laws are satisfied for --   any underlying 'Monoid', so we require a---   'Monoid' contraint instead of a 'Semiring'+--   'Monoid' constraint instead of a 'Semiring' --   constraint since 'times' can use --   the context of either. -- instance (Monoid a) => Semiring (Array a) where@@ -863,6 +970,16 @@ --------------------------------------------------------------------}  #if defined(VERSION_vector)+-- | The 'Semiring' instance for 'Vector a' can be interpreted as+--   treating each element of the list as coefficients to a+--   polynomial in one variable.+--+-- ==== __Examples__+--+-- @poly1 = Vector.fromList [1,2,3 :: Int]@+-- @poly2 = Vector.fromList [  2,1 :: Int]@+-- @poly1 * poly2@+-- fromList [2,5,8,3] instance Semiring a => Semiring (Vector a) where   zero  = Vector.empty   one   = Vector.singleton one@@ -926,7 +1043,7 @@   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}- + instance (UV.Unbox a, Ring a) => Ring (UV.Vector a) where   negate = UV.map negate   {-# INLINE negate #-}@@ -962,7 +1079,7 @@   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}-  + instance (SV.Storable a, Ring a) => Ring (SV.Vector a) where   negate = SV.map negate   {-# INLINE negate #-}@@ -986,7 +1103,7 @@  type ListBuilder a = forall b. (a -> b -> b) -> b -> b -{-# RULES +{-# RULES "listAddFB/left"  forall    (g :: ListBuilder a). listAdd    (build g) = listAddFBL g "listAddFB/right" forall xs (g :: ListBuilder a). listAdd xs (build g) = listAddFBR xs g   #-}
Data/Semiring/Generic.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP              #-} #if MIN_VERSION_base(4,6,0)+{-# LANGUAGE DeriveGeneric    #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators    #-} #endif@@ -34,6 +35,7 @@   , gtimes   , GRing(..)   , gnegate+  , GenericSemiring(..) #endif   ) where  @@ -43,6 +45,13 @@  import Prelude hiding (Num(..)) +-- | An Identity-style wrapper with a 'Generic' interface+--   to be used with '-XDerivingVia'.+newtype GenericSemiring a = GenericSemiring a+  deriving (Generic)+instance (Semiring a) => Semiring (GenericSemiring a) where+  zero = gzero; one = gone; plus = gplus; times = gtimes; + instance (Semiring a, Semiring b) => Semiring (a,b) where   zero = gzero; one = gone; plus = gplus; times = gtimes;  @@ -83,6 +92,8 @@   Generics --------------------------------------------------------------------} +-- | Generic 'Semiring' class, used to implement 'plus', 'times', 'zero',+--   and 'one' for product-like types implementing 'Generic'. class GSemiring f where   {-# MINIMAL gplus', gzero', gtimes', gone' #-}    gzero'  :: f a@@ -90,6 +101,8 @@   gplus'  :: f a -> f a -> f a   gtimes' :: f a -> f a -> f a +-- | Generic 'Ring' class, used to implement 'negate' for product-like+--   types implementing 'Generic'. class GRing f where   {-# MINIMAL gnegate' #-}   gnegate' :: f a -> f a
README.md view
@@ -39,9 +39,36 @@ use cases ========= -semirings themselves are useful as a way to express that a type is both a commutative and associative monoid.+semirings themselves are useful as a way to express that a type that supports a commutative and associative operation.+Some examples: -*-semirings are useful in a number of applications; such as matrix algebra, regular expressions, kleene algebras, graph theory, tropical algebra, dataflow analysis, power series, linear recurrence relations.+- Numbers {Int, Integer, Word, Double, etc.}:+  - 'plus' is 'Prelude.+'+  - 'times' is 'Prelude.*'+  - 'zero' is 0.+  - 'one' is 1.+- Booleans:+  - 'plus' is '||'+  - 'times' is '&&'+  - 'zero' is 'False'+  - 'one' is 'True'+- Set:+  - 'plus' is 'union'+  - 'times' is 'intersection'+  - 'zero' is the empty Set.+  - 'one' is the singleton Set containing the 'one' element of the underlying type.+- NFA:+  - 'plus' unions two NFAs.+  - 'times' appends two NFAs.+  - 'zero' is the NFA that acceptings nothing.+  - 'one' is the empty NFA.+- DFA:+  - 'plus' unions two DFAs.+  - 'times' intersects two DFAs.+  - 'zero' is the DFA that accepts nothing.+  - 'one' is the DFA that accepts everything.++*-semirings are useful in a number of applications; such as matrix algebra, regular expressions, kleene algebras, graph theory, tropical algebra, dataflow analysis, power series, and linear recurrence relations.  Some relevant (informal) reading material: 
semirings.cabal view
@@ -1,6 +1,6 @@ name:          semirings category:      Algebra, Data, Data Structures, Math, Maths, Mathematics-version:       0.2.1.1+version:       0.3.0.0 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -12,7 +12,21 @@ copyright:     Copyright (C) 2018 chessai synopsis:      two monoids as one, in holy haskimony description:-    In mathematics, a semiring is an algebraic structure consisting of a set together with two binary operations, one commutative and one associative. A semiring has two identity elements respective to its operations. Thus a semiring can be seen as a combination of two monoids, a commutative monoid and an associative monoid.+  Haskellers are usually familiar with monoids and semigroups. A monoid has an appending operation `<>` (or `mappend`),+  and an identity element, `mempty`. A semigroup has an appending `<>` operation, but does not require a `mempty` element.+  .+  A Semiring has two appending operations, `plus` and `times`, and two respective identity elements, `zero` and `one`.+  .+  More formally, a Semiring R is a set equipped with two binary relations `+` and `*`, such that:+  .+  (R,+) is a commutative monoid with identity element 0,+  . +  (R,*) is a monoid with identity element 1,+  . +  (*) left and right distributes over addition, and+  . +  multiplication by '0' annihilates R.+ build-type:    Simple extra-source-files: README.md CHANGELOG.md tested-with:   GHC == 7.4.1