module Data.AdditiveGroup
(
AdditiveGroup(..), (^-^), sumV, Sum(..)
) where
import Control.Applicative
import Data.Monoid (Monoid(..))
import Data.Complex hiding (magnitude)
import Data.MemoTrie
infixl 6 ^+^, ^-^
class AdditiveGroup v where
zeroV :: v
(^+^) :: v -> v -> v
negateV :: v -> v
(^-^) :: AdditiveGroup v => v -> v -> v
v ^-^ v' = v ^+^ negateV v'
sumV :: AdditiveGroup v => [v] -> v
sumV = foldr (^+^) zeroV
instance AdditiveGroup () where
zeroV = ()
() ^+^ () = ()
negateV = id
instance AdditiveGroup Double where
zeroV = 0.0
(^+^) = (+)
negateV = negate
instance AdditiveGroup Float where
zeroV = 0.0
(^+^) = (+)
negateV = negate
instance (RealFloat v, AdditiveGroup v) => AdditiveGroup (Complex v) where
zeroV = zeroV :+ zeroV
(^+^) = (+)
negateV = negate
instance (AdditiveGroup u,AdditiveGroup v) => AdditiveGroup (u,v) where
zeroV = (zeroV,zeroV)
(u,v) ^+^ (u',v') = (u^+^u',v^+^v')
negateV (u,v) = (negateV u,negateV v)
instance (AdditiveGroup u,AdditiveGroup v,AdditiveGroup w)
=> AdditiveGroup (u,v,w) where
zeroV = (zeroV,zeroV,zeroV)
(u,v,w) ^+^ (u',v',w') = (u^+^u',v^+^v',w^+^w')
negateV (u,v,w) = (negateV u,negateV v,negateV w)
instance AdditiveGroup v => AdditiveGroup (a -> v) where
zeroV = pure zeroV
(^+^) = liftA2 (^+^)
negateV = fmap negateV
instance (HasTrie u, AdditiveGroup v) => AdditiveGroup (u :->: v) where
zeroV = pure zeroV
(^+^) = liftA2 (^+^)
negateV = fmap negateV
newtype Sum a = Sum a
deriving (Eq, Ord, Read, Show, Bounded)
instance Functor Sum where
fmap f (Sum a) = Sum (f a)
instance Applicative Sum where
pure a = Sum a
Sum f <*> Sum x = Sum (f x)
instance AdditiveGroup a => Monoid (Sum a) where
mempty = Sum zeroV
mappend = liftA2 (^+^)