Additive.hs

{-# OPTIONS -fno-implicit-prelude #-}
module Algebra.Additive (
    {- * Class -}
    C,
    zero,
    (+), (-),
    negate, subtract,

    {- * Complex functions -}
    sum, sum1,

    {- * Instances for atomic types -}
    propAssociative,
    propCommutative,
    propIdentity,
    propInverse,
  ) where

import qualified Algebra.Laws as Laws

import qualified Data.Ratio as Ratio98
import qualified Prelude as P
import Prelude(fromInteger)
import PreludeBase


infixl 6  +, -

{- |
Additive a encapsulates the notion of a commutative group, specified
by the following laws:

@
          a + b === b + a
    (a + b) + c === a + (b + c)
       zero + a === a
   a + negate a === 0
@

Typical examples include integers, dollars, and vectors.

Minimal definition: '+', 'zero', and ('negate' or '(-)')
-}

class C a where
    -- | zero element of the vector space
    zero     :: a
    -- | add and subtract elements
    (+), (-) :: a -> a -> a
    -- | inverse with respect to '+'
    negate   :: a -> a

    negate a = zero - a
    a - b    = a + negate b

{- |
'subtract' is @(-)@ with swapped operand order.
This is the operand order which will be needed in most cases
of partial application.
-}
subtract :: C a => a -> a -> a
subtract = flip (-)




{- |
Sum up all elements of a list.
An empty list yields zero.
-}
sum :: (C a) => [a] -> a
sum = foldl (+) zero

{- |
Sum up all elements of a non-empty list.
This avoids including a zero which is useful for types
where no universal zero is available.
-}
sum1 :: (C a) => [a] -> a
sum1 = foldl1 (+)




{-* Instances for atomic types -}

instance C P.Integer where
    (+)    = (P.+)
    zero   = P.fromInteger 0
    negate = P.negate

instance C P.Int where
    (+)    = (P.+)
    zero   = P.fromInteger 0
    negate = P.negate

instance C P.Float where
    (+)    = (P.+)
    zero   = P.fromInteger 0
    negate = P.negate

instance C P.Double where
    (+)    = (P.+)
    zero   = P.fromInteger 0
    negate = P.negate


{-* Instances for composed types -}

instance (C v0, C v1) => C (v0, v1) where
   zero                   = (zero, zero)
   (+)    (x0,x1) (y0,y1) = ((+) x0 y0, (+) x1 y1)
   (-)    (x0,x1) (y0,y1) = ((-) x0 y0, (-) x1 y1)
   negate (x0,x1)         = (negate x0, negate x1)

instance (C v0, C v1, C v2) => C (v0, v1, v2) where
   zero                         = (zero, zero, zero)
   (+)    (x0,x1,x2) (y0,y1,y2) = ((+) x0 y0, (+) x1 y1, (+) x2 y2)
   (-)    (x0,x1,x2) (y0,y1,y2) = ((-) x0 y0, (-) x1 y1, (-) x2 y2)
   negate (x0,x1,x2)            = (negate x0, negate x1, negate x2)


instance (C v) => C [v] where
   zero   = []
   negate = map negate
   (+) (x:xs) (y:ys) = (+) x y : (+) xs ys
   (+) xs     []     = xs
   (+) []     ys     = ys
   (-) (x:xs) (y:ys) = (-) x y : (-) xs ys
   (-) xs     []     = xs
   (-) []     ys     = negate ys


instance (C v) => C (b -> v) where
   zero       _ = zero
   (+)    f g x = (+) (f x) (g x)
   (-)    f g x = (-) (f x) (g x)
   negate f   x = negate (f x)

{- * Properties -}

propAssociative :: (Eq a, C a) => a -> a -> a -> Bool
propCommutative :: (Eq a, C a) => a -> a -> Bool
propIdentity    :: (Eq a, C a) => a -> Bool
propInverse     :: (Eq a, C a) => a -> Bool

propCommutative  =  Laws.commutative (+)
propAssociative  =  Laws.associative (+)
propIdentity     =  Laws.identity (+) zero
propInverse      =  Laws.inverse (+) negate zero



-- legacy

instance (P.Integral a) => C (Ratio98.Ratio a) where
   zero                =  0
   (+)                 =  (P.+)
   (-)                 =  (P.-)
   negate              =  P.negate