semirings 0.3.1.2 → 0.4

raw patch · 6 files changed

+135/−265 lines, 6 filesdep −vectorPVP ok

version bump matches the API change (PVP)

Dependencies removed: vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +9/−0
• Data/Semiring.hs +79/−232
• Data/Semiring/Generic.hs +26/−13
• Data/Semiring/Tropical.hs +2/−0
• Data/Star.hs +5/−0
• semirings.cabal +14/−20

@@ -1,3 +1,12 @@+0.4: [2019.05.01]+-----------------+* Remove unlawful instances of `Ring` (thanks to @Bodigrim for noticing these)+* Add `fromNatural` to `Semiring` typeclass (thanks @Bodigrim)+* Remove Semiring/Ring instances for [] and Vector. (thanks @Bodigrim)+  These instances are better served by a dedicated polynomial package,+  which @Bodigrim has made at http://hackage.haskell.org/package/poly.+* Add isZero/isOne predicates.+ 0.3.1.2: [2019.04.02] --------------------- * Fix build error on windows caused by providing instances

@@ -33,12 +33,14 @@   , product   , sum'   , product'+  , isZero+  , isOne      -- * Types   , Add(..)   , Mul(..)   , WrappedNum(..)-#if defined(VERSION_containers) && MIN_VERSION_base(4,7,0) +#if defined(VERSION_containers) && MIN_VERSION_base(4,7,0)   , IntSetOf(..)   , IntMapOf(..) #endif@@ -50,7 +52,7 @@   ) where  import           Control.Applicative (Applicative(..), Const(..), liftA2)-import           Data.Bool (Bool(..), (||), (&&), not)+import           Data.Bool (Bool(..), (||), (&&)) #if MIN_VERSION_base(4,7,0) import           Data.Coerce (Coercible, coerce) #endif@@ -59,7 +61,7 @@ import           Data.Fixed (Fixed, HasResolution) import           Data.Foldable (Foldable(foldMap)) import qualified Data.Foldable as Foldable-import           Data.Function ((.), const, id)+import           Data.Function ((.), const) #if defined(VERSION_unordered_containers) || defined(VERSION_containers) import           Data.Function (flip) #endif@@ -76,7 +78,6 @@ import qualified Data.HashSet as HashSet #endif import           Data.Int (Int, Int8, Int16, Int32, Int64)-import qualified Data.List as List import           Data.Maybe (Maybe(..)) #if MIN_VERSION_base(4,12,0) import           Data.Monoid (Ap(..))@@ -103,20 +104,8 @@ import           Data.Set (Set) import qualified Data.Set as Set #endif--- #if defined(VERSION_primitive)--- import           Data.Primitive.Array (Array(..))--- import qualified Data.Primitive.Array as Array--- #endif import           Data.Traversable (Traversable) import           Data.Typeable (Typeable)-#if defined(VERSION_vector)-import           Data.Bool (otherwise)-import           Data.Ord (Ordering(..), compare, min, max)-import           Data.Vector (Vector)-import qualified Data.Vector as Vector-import qualified Data.Vector.Storable as SV-import qualified Data.Vector.Unboxed as UV-#endif import           Data.Word (Word, Word8, Word16, Word32, Word64) import           Foreign.C.Types   (CChar, CClock, CDouble, CFloat, CInt,@@ -127,7 +116,6 @@    CUSeconds, CUShort, CWchar) import           Foreign.Ptr (IntPtr, WordPtr) import           Foreign.Storable (Storable)-import           GHC.Base (build) import           GHC.Enum (Enum, Bounded) import           GHC.Float (Float, Double) #if MIN_VERSION_base(4,6,1)@@ -137,7 +125,7 @@ import           GHC.Integer (Integer) import qualified GHC.Num as Num import           GHC.Read (Read)-import           GHC.Real (Integral, Fractional, Real, RealFrac)+import           GHC.Real (Integral, Fractional, Real, RealFrac, fromIntegral) import           GHC.Show (Show) import           Numeric.Natural (Natural) @@ -316,6 +304,7 @@  instance Semiring a => Semigroup (Add a) where   Add a <> Add b = Add (a + b)+  stimes n (Add a) = Add (fromNatural (fromIntegral n) * a)   {-# INLINE (<>) #-}  instance Semiring a => Monoid (Add a) where@@ -324,6 +313,13 @@   {-# INLINE mempty #-}   {-# INLINE mappend #-} +-- | This is an internal type, solely for purposes+-- of default implementation of 'fromNatural'.+newtype Add' a = Add' { getAdd' :: a }++instance Semiring a => Semigroup (Add' a) where+  Add' a <> Add' b = Add' (a + b)+ -- | Monoid under 'times'. Analogous to 'Data.Monoid.Product', but --   uses the 'Semiring' constraint rather than 'Num'. newtype Mul a = Mul { getMul :: a }@@ -388,6 +384,7 @@   zero  = 0   times = (Num.*)   one   = 1+  fromNatural = fromIntegral  instance Num.Num a => Ring (WrappedNum a) where   negate = Num.negate@@ -423,26 +420,31 @@ -- [/additive commutativity/] --     @x '+' y = y '+' x@ -- [/multiplicative left identity/]---     @'one' '*' x = x@    +--     @'one' '*' x = x@ -- [/multiplicative right identity/]---     @x '*' 'one' = x@ +--     @x '*' 'one' = x@ -- [/multiplicative associativity/] --     @x '*' (y '*' z) = (x '*' y) '*' z@ -- [/left-distributivity of '*' over '+'/] --     @x '*' (y '+' z) = (x '*' y) '+' (x '*' z)@--- [/right-distributivity of '*' over '+'/]   +-- [/right-distributivity of '*' over '+'/] --     @(x '+' y) '*' z = (x '*' z) '+' (y '*' z)@ -- [/annihilation/] --     @'zero' '*' x = x '*' 'zero' = 'zero'@  class Semiring a where #if __GLASGOW_HASKELL__ >= 708-  {-# MINIMAL plus, zero, times, one #-}+  {-# MINIMAL plus, times, (zero, one | fromNatural) #-} #endif   plus  :: a -> a -> a -- ^ Commutative Operation   zero  :: a           -- ^ Commutative Unit+  zero = fromNatural 0   times :: a -> a -> a -- ^ Associative Operation   one   :: a           -- ^ Associative Unit+  one = fromNatural 1+  fromNatural :: Natural -> a -- ^ Homomorphism of additive semigroups+  fromNatural 0 = zero+  fromNatural n = getAdd' (stimes n (Add' one))  -- | The class of semirings with an additive inverse. --@@ -471,10 +473,12 @@   zero        = const zero   times f g x = f x `times` g x   one         = const one+  fromNatural = const . fromNatural   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance Ring b => Ring (a -> b) where   negate f x = negate (f x)@@ -485,10 +489,12 @@   zero      = ()   times _ _ = ()   one       = ()+  fromNatural _ = ()   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance Ring () where   negate _ = ()@@ -499,48 +505,25 @@   zero      = Proxy   times _ _ = Proxy   one       = Proxy+  fromNatural _ = Proxy   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance Semiring Bool where   plus  = (||)   zero  = False   times = (&&)   one   = True-  {-# INLINE plus  #-}-  {-# INLINE zero  #-}-  {-# INLINE times #-}-  {-# INLINE one   #-}--instance Ring Bool where-  negate = not-  {-# INLINE negate #-}---- | 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 -- See Section: List fusion-  times = listTimes -- See Section: List fusion+  fromNatural 0 = False+  fromNatural _ = True   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}--instance Ring a => Ring [a] where-  negate = fmap negate-  {-# INLINE negate #-}+  {-# INLINE fromNatural #-}  instance Semiring a => Semiring (Maybe a) where   zero  = Nothing@@ -553,24 +536,26 @@   times Nothing _ = Nothing   times _ Nothing = Nothing   times (Just x) (Just y) = Just (times x y)++  fromNatural 0 = Nothing+  fromNatural n = Just (fromNatural n)   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}--instance Ring a => Ring (Maybe a) where-  negate = fmap negate-  {-# INLINE negate #-}+  {-# INLINE fromNatural #-}  instance Semiring a => Semiring (IO a) where   zero  = pure zero   one   = pure one   plus  = liftA2 plus   times = liftA2 times+  fromNatural = pure . fromNatural   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance Ring a => Ring (IO a) where   negate = fmap negate@@ -581,10 +566,12 @@   Dual x `plus` Dual y = Dual (y `plus` x)   one = Dual one   Dual x `times` Dual y = Dual (y `times` x)+  fromNatural = Dual . fromNatural   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance Ring a => Ring (Dual a) where   negate (Dual x) = Dual (negate x)@@ -595,10 +582,12 @@   one  = Const one   plus  (Const x) (Const y) = Const (x `plus`  y)   times (Const x) (Const y) = Const (x `times` y)+  fromNatural = Const . fromNatural   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance Ring a => Ring (Const a b) where   negate (Const x) = Const (negate x)@@ -611,10 +600,12 @@   plus  (x :+ y) (x' :+ y') = plus x x' :+ plus y y'   times (x :+ y) (x' :+ y')     = (x * x' - (y * y')) :+ (x * y' + y * x')+  fromNatural n = fromNatural n :+ zero   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance Ring a => Ring (Complex a) where   negate (x :+ y) = negate x :+ negate y@@ -626,10 +617,12 @@   one   = pure one   plus  = liftA2 plus   times = liftA2 times+  fromNatural = pure . fromNatural   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  instance (Ring a, Applicative f) => Ring (Ap f a) where   negate = fmap negate@@ -638,10 +631,8 @@  #if MIN_VERSION_base(4,12,0) deriving instance Semiring (Predicate a)-deriving instance Ring (Predicate a)  deriving instance Semiring a => Semiring (Equivalence a)-deriving instance Ring a => Ring (Equivalence a)  deriving instance Semiring a => Semiring (Op a b) deriving instance Ring a => Ring (Op a b)@@ -653,10 +644,12 @@ ;  one   = 1                      \ ;  plus  x y = (Num.+) x y        \ ;  times x y = (Num.*) x y        \+;  fromNatural = fromIntegral     \ ;  {-# INLINE zero #-}            \ ;  {-# INLINE one  #-}            \ ;  {-# INLINE plus #-}            \ ;  {-# INLINE times #-}           \+;  {-# INLINE fromNatural #-}     \ }  deriveSemiring(Int)@@ -725,10 +718,12 @@   one   = 1 % 1   plus  = (Num.+)   times = (Num.*)+  fromNatural n = fromIntegral n % 1   {-# INLINE zero  #-}   {-# INLINE one   #-}   {-# INLINE plus  #-}   {-# INLINE times #-}+  {-# INLINE fromNatural #-} deriving instance Semiring a => Semiring (Identity a) #if MIN_VERSION_base(4,6,0) deriving instance Semiring a => Semiring (Down a)@@ -738,10 +733,12 @@   one   = 1   plus  = (Num.+)   times = (Num.*)+  fromNatural = fromIntegral   {-# INLINE zero  #-}   {-# INLINE one   #-}   {-# INLINE plus  #-}   {-# INLINE times #-}+  {-# INLINE fromNatural #-}  #define deriveRing(ty)          \ instance Ring (ty) where {      \@@ -836,10 +833,13 @@   one   = Set.singleton mempty   plus  = Set.union   times xs ys = Foldable.foldMap (flip Set.map ys . mappend) xs+  fromNatural 0 = zero+  fromNatural _ = one   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  #if MIN_VERSION_base(4,7,0) -- | Wrapper to mimic 'Set' ('Data.Semigroup.Sum' 'Int'),@@ -870,10 +870,13 @@         | k :: a <- coerce IntSet.toList xs         , l :: a <- coerce IntSet.toList ys         ]+  fromNatural 0 = zero+  fromNatural _ = one   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-} #endif  -- | The multiplication laws are satisfied for@@ -891,10 +894,13 @@         | (k,v) <- Map.toList xs         , (l,u) <- Map.toList ys         ]+  fromNatural 0 = zero+  fromNatural n = Map.singleton mempty (fromNatural n)   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  #if MIN_VERSION_base(4,7,0) -- | Wrapper to mimic 'Map' ('Data.Semigroup.Sum' 'Int') v,@@ -925,10 +931,13 @@         | (k :: k, v :: v) <- coerce (IntMap.toList :: IntMap v -> [(Int, v)]) xs         , (l :: k, u :: v) <- coerce (IntMap.toList :: IntMap v -> [(Int, v)]) ys         ]+  fromNatural 0 = zero+  fromNatural n = coerce (IntMap.singleton :: Int -> v -> IntMap v) (mempty :: k) (fromNatural n :: v)   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-} #endif  #endif@@ -949,10 +958,13 @@   one  = HashSet.singleton mempty   plus = HashSet.union   times xs ys = Foldable.foldMap (flip HashSet.map ys . mappend) xs+  fromNatural 0 = zero+  fromNatural _ = one   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}+  {-# INLINE fromNatural #-}  -- | The multiplication laws are satisfied for --   any underlying 'Monoid' as the key type,@@ -969,186 +981,21 @@         | (k,v) <- HashMap.toList xs         , (l,u) <- HashMap.toList ys         ]-  {-# INLINE plus  #-}-  {-# INLINE zero  #-}-  {-# INLINE times #-}-  {-# INLINE one   #-}-#endif--{---------------------------------------------------------------------  Instances (primitive)---------------------------------------------------------------------}--#if defined(VERSION_primitive)--- | The multiplication laws are satisfied for---   any underlying 'Monoid', so we require a---   'Monoid' constraint instead of a 'Semiring'---   constraint since 'times' can use---   the context of either.--- instance (Monoid a) => Semiring (Array a) where---   zero  = mempty---   one   = runST e where---     e :: forall s. Monoid a => ST s (Array a)---     e = (Array.newArray 1 mempty) >>= Array.unsafeFreezeArray---   plus _ _ = mempty---   times _ _ = mempty---   {-# INLINE plus  #-}---   {-# INLINE zero  #-}---   {-# INLINE times #-}---   {-# INLINE one   #-}-#endif--{---------------------------------------------------------------------  Instances (vector)---------------------------------------------------------------------}--#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-  plus xs ys =-    case compare (Vector.length xs) (Vector.length ys) of-      EQ -> Vector.zipWith (+) xs ys-      LT -> Vector.unsafeAccumulate (+) ys (Vector.indexed xs)-      GT -> Vector.unsafeAccumulate (+) xs (Vector.indexed ys)-  times signal kernel-    | Vector.null signal = Vector.empty-    | Vector.null kernel = Vector.empty-    | otherwise = Vector.generate (slen + klen - 1) f-    where-      !slen = Vector.length signal-      !klen = Vector.length kernel-      f n = Foldable.foldl'-        (\a k -> a +-                 Vector.unsafeIndex signal k *-                 Vector.unsafeIndex kernel (n - k)-        )-        zero-        [kmin .. kmax]-        where-          !kmin = max 0 (n - (klen - 1))-          !kmax = min n (slen - 1)-  {-# INLINE plus  #-}-  {-# INLINE zero  #-}-  {-# INLINE times #-}-  {-# INLINE one   #-}--instance Ring a => Ring (Vector a) where-  negate = Vector.map negate-  {-# INLINE negate #-}--instance (UV.Unbox a, Semiring a) => Semiring (UV.Vector a) where-  zero = UV.empty-  one  = UV.singleton one-  plus xs ys =-    case compare (UV.length xs) (UV.length ys) of-      EQ -> UV.zipWith (+) xs ys-      LT -> UV.unsafeAccumulate (+) ys (UV.indexed xs)-      GT -> UV.unsafeAccumulate (+) xs (UV.indexed ys)-  times signal kernel-    | UV.null signal = UV.empty-    | UV.null kernel = UV.empty-    | otherwise = UV.generate (slen + klen - 1) f-    where-      !slen = UV.length signal-      !klen = UV.length kernel-      f n = Foldable.foldl'-        (\a k -> a +-                 UV.unsafeIndex signal k *-                 UV.unsafeIndex kernel (n - k)-        )-        zero-        [kmin .. kmax]-        where-          !kmin = max 0 (n - (klen - 1))-          !kmax = min n (slen - 1)-  {-# INLINE plus  #-}-  {-# INLINE zero  #-}-  {-# INLINE times #-}-  {-# INLINE one   #-}--instance (UV.Unbox a, Ring a) => Ring (UV.Vector a) where-  negate = UV.map negate-  {-# INLINE negate #-}--instance (SV.Storable a, Semiring a) => Semiring (SV.Vector a) where-  zero = SV.empty-  one = SV.singleton one-  plus xs ys =-    case compare lxs lys of-      EQ -> SV.zipWith (+) xs ys-      LT -> SV.unsafeAccumulate_ (+) ys (SV.enumFromN 0 lxs) xs-      GT -> SV.unsafeAccumulate_ (+) xs (SV.enumFromN 0 lys) ys-    where-      lxs = SV.length xs-      lys = SV.length ys-  times signal kernel-    | SV.null signal = SV.empty-    | SV.null kernel = SV.empty-    | otherwise = SV.generate (slen + klen - 1) f-      where-        !slen = SV.length signal-        !klen = SV.length kernel-        f n = Foldable.foldl'-          (\a k -> a +-                  SV.unsafeIndex signal k *-                  SV.unsafeIndex kernel (n - k))-                zero-                [kmin .. kmax]-          where-            !kmin = max 0 (n - (klen - 1))-            !kmax = min n (slen - 1)+  fromNatural 0 = zero+  fromNatural n = HashMap.singleton mempty (fromNatural n)   {-# INLINE plus  #-}   {-# INLINE zero  #-}   {-# INLINE times #-}   {-# INLINE one   #-}--instance (SV.Storable a, Ring a) => Ring (SV.Vector a) where-  negate = SV.map negate-  {-# INLINE negate #-}+  {-# INLINE fromNatural #-} #endif --- [Section: List fusion]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-listAdd, listTimes :: Semiring a => [a] -> [a] -> [a]-listAdd [] ys = ys-listAdd xs [] = xs-listAdd (x:xs) (y:ys) = (x + y) : listAdd xs ys-{-# NOINLINE [0] listAdd #-}--listTimes _  [] = []-listTimes xs ys = List.foldr f [] xs-  where-    f x zs = List.foldr (g x) id ys (zero : zs)-    g x y a []     = x `times` y : a []-    g x y a (z:zs) = x `times` y `plus` z : a zs-{-# NOINLINE [0] listTimes #-}--type ListBuilder a = forall b. (a -> b -> b) -> b -> b--{-# 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-  #-}---- a definition of listAdd which can be fused on its left argument-listAddFBL :: Semiring a => ListBuilder a -> [a] -> [a]-listAddFBL xf = xf f id where-  f x xs (y:ys) = x + y : xs ys-  f x xs []     = x : xs []+-- | Is the value 'zero'?+isZero :: (Eq a, Semiring a) => a -> Bool+isZero x = x == zero+{-# INLINEABLE isZero #-} --- a definition of listAdd which can be fused on its right argument-listAddFBR :: Semiring a => [a] -> ListBuilder a -> [a]-listAddFBR xs' yf = yf f id xs' where-  f y ys (x:xs) = x + y : ys xs-  f y ys []     = y : ys []+-- | Is the value 'one'?+isOne :: (Eq a, Semiring a) => a -> Bool+isOne x = x == one+{-# INLINEABLE isOne #-}

@@ -25,8 +25,8 @@ ----------------------------------------------------------------------------  module Data.Semiring.Generic-  ( -#if MIN_VERSION_base(4,6,0) +  (+#if MIN_VERSION_base(4,6,0)     GSemiring(..)   , gzero   , gone@@ -36,11 +36,12 @@   , gnegate   , GenericSemiring(..) #endif-  ) where +  ) where  #if MIN_VERSION_base(4,6,0) import           Data.Semiring import           GHC.Generics+import           Numeric.Natural (Natural)  import Prelude hiding (Num(..)) @@ -50,25 +51,25 @@   deriving (Generic)  instance (Semiring a) => Semiring (GenericSemiring a) where-  zero = gzero; one = gone; plus = gplus; times = gtimes; +  zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;  instance (Semiring a, Semiring b) => Semiring (a,b) where-  zero = gzero; one = gone; plus = gplus; times = gtimes; +  zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;  instance (Semiring a, Semiring b, Semiring c) => Semiring (a,b,c) where-  zero = gzero; one = gone; plus = gplus; times = gtimes;+  zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;  instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a,b,c,d) where-  zero = gzero; one = gone; plus = gplus; times = gtimes;+  zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;  instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a,b,c,d,e) where-  zero = gzero; one = gone; plus = gplus; times = gtimes;+  zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;  instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f) => Semiring (a,b,c,d,e,f) where-  zero = gzero; one = gone; plus = gplus; times = gtimes;+  zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;  instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g) => Semiring (a,b,c,d,e,f,g) where-  zero = gzero; one = gone; plus = gplus; times = gtimes;+  zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;  instance (Ring a, Ring b) => Ring (a,b) where   negate = gnegate@@ -95,18 +96,19 @@ -- | Generic 'Semiring' class, used to implement 'plus', 'times', 'zero', --   and 'one' for product-like types implementing 'Generic'. class GSemiring f where-#if __GLASGOW_HASKELL__ >= 708  -  {-# MINIMAL gplus', gzero', gtimes', gone' #-}+#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL gplus', gzero', gtimes', gone', gfromNatural' #-} #endif   gzero'  :: f a   gone'   :: f a   gplus'  :: f a -> f a -> f a   gtimes' :: f a -> f a -> f a+  gfromNatural' :: Natural -> f a  -- | Generic 'Ring' class, used to implement 'negate' for product-like --   types implementing 'Generic'. class GRing f where-#if __GLASGOW_HASKELL__ >= 708  +#if __GLASGOW_HASKELL__ >= 708   {-# MINIMAL gnegate' #-} #endif   gnegate' :: f a -> f a@@ -152,6 +154,13 @@ gtimes :: (Generic a, GSemiring (Rep a)) => a -> a -> a gtimes x y = to $ from x `gtimes'` from y +-- | Generically generate a 'Semiring' 'fromNatural' for any product-like type+-- implementing 'Generic'.+--+-- It is only defined for product types.+gfromNatural :: (Generic a, GSemiring (Rep a)) => Natural -> a+gfromNatural = to . gfromNatural'+ -- | Generically generate a 'Ring' 'negate' operation for any type -- implementing 'Generic'. It is only defined for product types. --@@ -166,6 +175,7 @@   gone'  = U1   gplus'  _ _ = U1   gtimes' _ _ = U1+  gfromNatural' _ = U1  instance GRing U1 where   gnegate' _ = U1@@ -175,6 +185,7 @@   gone'  = gone'  :*: gone'   gplus'  (a :*: b) (c :*: d) = gplus'  a c :*: gplus' b d   gtimes' (a :*: b) (c :*: d) = gtimes' a c :*: gplus' b d+  gfromNatural' n = gfromNatural' n :*: gfromNatural' n  instance (GRing a, GRing b) => GRing (a :*: b) where   gnegate' (a :*: b) = gnegate' a :*: gnegate' b@@ -184,6 +195,7 @@   gone'  = M1 gone'   gplus'  (M1 x) (M1 y) = M1 $ gplus'  x y   gtimes' (M1 x) (M1 y) = M1 $ gtimes' x y+  gfromNatural' = M1 . gfromNatural'  instance (GRing a) => GRing (M1 i c a) where   gnegate' (M1 x) = M1 $ gnegate' x@@ -193,6 +205,7 @@   gone'  = K1 one   gplus'  (K1 x) (K1 y) = K1 $ plus  x y   gtimes' (K1 x) (K1 y) = K1 $ times x y+  gfromNatural' = K1 . fromNatural  instance (Ring a) => GRing (K1 i a) where   gnegate' (K1 x) = K1 $ negate x

@@ -123,6 +123,8 @@   times Infinity _ = Infinity   times _ Infinity = Infinity   times (Tropical x) (Tropical y) = Tropical (Monoid.mappend x y)+  fromNatural 0 = zero+  fromNatural _ = one  instance forall e a. (Ord a, Monoid.Monoid a, Extremum e) => Star (Tropical e a) where   star _ = one

@@ -1,6 +1,11 @@ {-# LANGUAGE CPP               #-} {-# LANGUAGE NoImplicitPrelude #-} +-----------------------------------------------------------------------------+-- |+-- A class for *-semirings (pron. "star-semirings").+--+----------------------------------------------------------------------------- module Data.Star   ( Star(..)   ) where

@@ -1,6 +1,6 @@ name:          semirings category:      Algebra, Data, Data Structures, Math, Maths, Mathematics-version:       0.3.1.2+version:       0.4 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -20,16 +20,16 @@   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 +tested-with:   GHC == 7.4.1              , GHC == 7.4.2              , GHC == 7.6.1              , GHC == 7.6.2@@ -39,14 +39,19 @@              , GHC == 7.10.1              , GHC == 7.10.2              , GHC == 7.10.3-             , GHC == 8.0.1 +             , GHC == 8.0.1              , GHC == 8.0.2-             , GHC == 8.2.1 +             , GHC == 8.2.1              , GHC == 8.2.2              , GHC == 8.4.1              , GHC == 8.4.2              , GHC == 8.4.3+             , GHC == 8.4.4              , GHC == 8.6.1+             , GHC == 8.6.2+             , GHC == 8.6.3+             , GHC == 8.6.4+             , GHC == 8.6.5  source-repository head   type: git@@ -78,14 +83,6 @@   default: True   manual: True -flag vector-  description:-    You can disable the use of the `vector` package using `-f-vector`.-    .-    Disabling this may be useful for accelerating builds in sandboxes for expert users.-  default: True-  manual: True- library   default-language: Haskell98   ghc-options: -Wall@@ -93,7 +90,7 @@   build-depends:       base >= 4.5 && < 5     , integer-gmp-  +   if impl(ghc < 7.10)     build-depends:         nats >= 0.1 && < 2@@ -113,7 +110,7 @@   if impl(ghc >= 7.6.1)     exposed-modules:       Data.Semiring.Generic-   +     if flag(containers)       build-depends: containers >= 0.5.4 && < 0.6.1.0 @@ -122,6 +119,3 @@      if flag(hashable) && flag(unordered-containers)       build-depends: unordered-containers >= 0.2  && < 0.3--    if flag(vector)-      build-depends: vector >= 0.7 && < 0.13.0.0