{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}
module Numeric.Monoid.Additive
(
-- * Additive Monoids
AdditiveMonoid(..)
, sum
) where
import Data.Foldable hiding (sum)
import Data.Int
import Data.Word
import Numeric.Module.Class
import Numeric.Natural.Internal
import Numeric.Semigroup.Additive
import Prelude hiding ((+), sum, replicate)
-- | An additive monoid
--
-- > zero + a = a = a + zero
class (LeftModule Natural m, RightModule Natural m) => AdditiveMonoid m where
zero :: m
replicate :: Whole n => n -> m -> m
replicate 0 _ = zero
replicate n x0 = f x0 n
where
f x y
| even y = f (x + x) (y `quot` 2)
| y == 1 = x
| otherwise = g (x + x) (unsafePred 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) (unsafePred y `quot` 2) (x + z)
sumWith :: Foldable f => (a -> m) -> f a -> m
sumWith f = foldl' (\b a -> b + f a) zero
sum :: (Foldable f, AdditiveMonoid m) => f m -> m
sum = sumWith id
instance AdditiveMonoid Bool where
zero = False
replicate 0 _ = False
replicate _ r = r
instance AdditiveMonoid Natural where
zero = 0
replicate n r = toNatural n * r
instance AdditiveMonoid Integer where
zero = 0
replicate n r = toInteger n * r
instance AdditiveMonoid Int where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Int8 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Int16 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Int32 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Int64 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Word where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Word8 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Word16 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Word32 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid Word64 where
zero = 0
replicate n r = fromIntegral n * r
instance AdditiveMonoid r => AdditiveMonoid (e -> r) where
zero = const zero
sumWith f xs e = sumWith (`f` e) xs
replicate n r e = replicate n (r e)
instance AdditiveMonoid () where
zero = ()
replicate _ () = ()
sumWith _ _ = ()
instance (AdditiveMonoid a, AdditiveMonoid b) => AdditiveMonoid (a,b) where
zero = (zero,zero)
replicate n (a,b) = (replicate n a, replicate n b)
instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c) => AdditiveMonoid (a,b,c) where
zero = (zero,zero,zero)
replicate n (a,b,c) = (replicate n a, replicate n b, replicate n c)
instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d) => AdditiveMonoid (a,b,c,d) where
zero = (zero,zero,zero,zero)
replicate n (a,b,c,d) = (replicate n a, replicate n b, replicate n c, replicate n d)
instance (AdditiveMonoid a, AdditiveMonoid b, AdditiveMonoid c, AdditiveMonoid d, AdditiveMonoid e) => AdditiveMonoid (a,b,c,d,e) where
zero = (zero,zero,zero,zero,zero)
replicate n (a,b,c,d,e) = (replicate n a, replicate n b, replicate n c, replicate n d, replicate n e)