module Numeric.Monoid.Multiplicative.Internal
( Unital(..)
, product
, FreeUnitalAlgebra(..)
) where
import Data.Foldable hiding (product)
import Data.Int
import Data.Word
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Prelude hiding ((*), foldr, product)
import Numeric.Semiring.Internal
import Numeric.Monoid.Additive
import Numeric.Natural.Internal
infixr 8 `pow`
class Multiplicative r => Unital r where
one :: r
pow :: Whole n => r -> n -> r
pow _ 0 = one
pow x0 y0 = f x0 y0 where
f x y
| even y = f (x * x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x * x) ((y 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 1) `quot` 2) (x * z)
productWith :: Foldable f => (a -> r) -> f a -> r
productWith f = foldl' (\b a -> b * f a) one
product :: (Foldable f, Unital r) => f r -> r
product = productWith id
instance Unital Bool where one = True
instance Unital Integer where one = 1
instance Unital Int where one = 1
instance Unital Int8 where one = 1
instance Unital Int16 where one = 1
instance Unital Int32 where one = 1
instance Unital Int64 where one = 1
instance Unital Natural where one = 1
instance Unital Word where one = 1
instance Unital Word8 where one = 1
instance Unital Word16 where one = 1
instance Unital Word32 where one = 1
instance Unital Word64 where one = 1
instance Unital () where one = ()
instance (Unital a, Unital b) => Unital (a,b) where
one = (one,one)
instance (Unital a, Unital b, Unital c) => Unital (a,b,c) where
one = (one,one,one)
instance (Unital a, Unital b, Unital c, Unital d) => Unital (a,b,c,d) where
one = (one,one,one,one)
instance (Unital a, Unital b, Unital c, Unital d, Unital e) => Unital (a,b,c,d,e) where
one = (one,one,one,one,one)
class (FreeAlgebra r a) => FreeUnitalAlgebra r a where
unit :: r -> a -> r
instance (Unital r, FreeUnitalAlgebra r a) => Unital (a -> r) where
one = unit one
instance FreeUnitalAlgebra () a where
unit _ _ = ()
instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra (a -> r) b where
unit f b a = unit (f a) b
instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b) => FreeUnitalAlgebra r (a,b) where
unit r (a,b) = unit r a * unit r b
instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c) => FreeUnitalAlgebra r (a,b,c) where
unit r (a,b,c) = unit r a * unit r b * unit r c
instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d) => FreeUnitalAlgebra r (a,b,c,d) where
unit r (a,b,c,d) = unit r a * unit r b * unit r c * unit r d
instance (FreeUnitalAlgebra r a, FreeUnitalAlgebra r b, FreeUnitalAlgebra r c, FreeUnitalAlgebra r d, FreeUnitalAlgebra r e) => FreeUnitalAlgebra r (a,b,c,d,e) where
unit r (a,b,c,d,e) = unit r a * unit r b * unit r c * unit r d * unit r e
instance (AdditiveMonoid r, Semiring r) => FreeUnitalAlgebra r [a] where
unit r [] = r
unit _ _ = zero
instance (AdditiveMonoid r, Semiring r) => FreeUnitalAlgebra r (Seq a) where
unit r a | Seq.null a = r
| otherwise = zero