module Numeric.Semiring.Internal
(
Multiplicative(..)
, pow1pIntegral
, product1
, Semiring
, FreeAlgebra(..)
) where
import Data.Foldable hiding (sum, concat)
import Data.Semigroup.Foldable
import Data.Int
import Data.Word
import Prelude hiding ((*), (+), negate, subtract,(), recip, (/), foldr, sum, product, replicate, concat)
import qualified Prelude
import Numeric.Natural.Internal
import Numeric.Semigroup.Additive
import Numeric.Addition.Abelian
infixr 8 `pow1p`
infixl 7 *
class Multiplicative r where
(*) :: r -> r -> r
pow1p :: Whole n => r -> n -> r
pow1p x0 y0 = f x0 (y0 Prelude.+ 1) where
f x y
| even y = f (x * x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x * x) ((y Prelude.- 1) `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 Prelude.- 1) `quot` 2) (x * z)
productWith1 :: Foldable1 f => (a -> r) -> f a -> r
productWith1 f = maybe (error "Numeric.Multiplicative.Semigroup.productWith1: empty structure") id . foldl' mf Nothing
where
mf Nothing y = Just $! f y
mf (Just x) y = Just $! x * f y
product1 :: (Foldable1 f, Multiplicative r) => f r -> r
product1 = productWith1 id
pow1pIntegral :: (Integral r, Integral n) => r -> n -> r
pow1pIntegral r n = r ^ (1 Prelude.+ n)
instance Multiplicative Bool where
(*) = (&&)
pow1p m _ = m
instance Multiplicative Natural where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Integer where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Int where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Int8 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Int16 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Int32 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Int64 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Word where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Word8 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Word16 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Word32 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative Word64 where
(*) = (Prelude.*)
pow1p = pow1pIntegral
instance Multiplicative () where
_ * _ = ()
pow1p _ _ = ()
instance (Multiplicative a, Multiplicative b) => Multiplicative (a,b) where
(a,b) * (c,d) = (a * c, b * d)
instance (Multiplicative a, Multiplicative b, Multiplicative c) => Multiplicative (a,b,c) where
(a,b,c) * (i,j,k) = (a * i, b * j, c * k)
instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d) => Multiplicative (a,b,c,d) where
(a,b,c,d) * (i,j,k,l) = (a * i, b * j, c * k, d * l)
instance (Multiplicative a, Multiplicative b, Multiplicative c, Multiplicative d, Multiplicative e) => Multiplicative (a,b,c,d,e) where
(a,b,c,d,e) * (i,j,k,l,m) = (a * i, b * j, c * k, d * l, e * m)
class (Additive r, Abelian r, Multiplicative r) => Semiring r
instance Semiring Integer
instance Semiring Natural
instance Semiring Bool
instance Semiring Int
instance Semiring Int8
instance Semiring Int16
instance Semiring Int32
instance Semiring Int64
instance Semiring Word
instance Semiring Word8
instance Semiring Word16
instance Semiring Word32
instance Semiring Word64
instance Semiring ()
instance (Semiring a, Semiring b) => Semiring (a, b)
instance (Semiring a, Semiring b, Semiring c) => Semiring (a, b, c)
instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a, b, c, d)
instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a, b, c, d, e)
class Semiring r => FreeAlgebra r a where
join :: (a -> a -> r) -> a -> r
instance FreeAlgebra r a => Multiplicative (a -> r) where
f * g = join $ \a b -> f a * g b
instance FreeAlgebra r a => Semiring (a -> r)
instance FreeAlgebra () a where
join _ _ = ()
instance (FreeAlgebra r b, FreeAlgebra r a) => FreeAlgebra (b -> r) a where
join f a b = join (\a1 a2 -> f a1 a2 b) a
instance (FreeAlgebra r a, FreeAlgebra r b) => FreeAlgebra r (a,b) where
join f (a,b) = join (\a1 a2 -> join (\b1 b2 -> f (a1,b1) (a2,b2)) b) a
instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c) => FreeAlgebra r (a,b,c) where
join f (a,b,c) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> f (a1,b1,c1) (a2,b2,c2)) c) b) a
instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d) => FreeAlgebra r (a,b,c,d) where
join f (a,b,c,d) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> f (a1,b1,c1,d1) (a2,b2,c2,d2)) d) c) b) a
instance (FreeAlgebra r a, FreeAlgebra r b, FreeAlgebra r c, FreeAlgebra r d, FreeAlgebra r e) => FreeAlgebra r (a,b,c,d,e) where
join f (a,b,c,d,e) = join (\a1 a2 -> join (\b1 b2 -> join (\c1 c2 -> join (\d1 d2 -> join (\e1 e2 -> f (a1,b1,c1,d1,e1) (a2,b2,c2,d2,e2)) e) d) c) b) a