module Data.AdditiveGroup
(
AdditiveGroup(..), (^-^), sumV
) where
import Control.Applicative
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