Group.hs

{-# LANGUAGE TypeSynonymInstances #-}
module Data.Algebra.Group where

import Control.Applicative
import qualified Data.Map as M
import qualified Data.IntMap as IM
import Data.Ratio

type Poly = []

infixr 4 ^+^
infixr 4 ^-^

-- | The algebraic structure of a group.  Written additively.  Required functions: 'zero' and ('^-^' or ('^+^' and 'neg')).
class Group g where
	zero :: g
	(^+^) :: g -> g -> g
	(^-^) :: g -> g -> g
	neg :: g -> g
	
	a ^+^ b = a ^-^ neg b
	a ^-^ b = a ^+^ neg b
	neg a = zero ^-^ a

instance Group Bool where
	zero = False
	(^+^) = (/=)
	(^-^) = (/=)
	neg = id

instance Group Int where
	zero = 0
	(^+^) = (+)
	(^-^) = (-)
	neg = negate

instance Group Integer where
	zero = 0
	(^+^) = (+)
	(^-^) = (-)
	neg = negate

instance Group Double where
	zero = 0
	(^+^) = (+)
	(^-^) = (-)
	neg = negate

instance Integral a => Group (Ratio a) where
	{-# SPECIALIZE instance Group Rational #-}
	zero = 0
	(^+^) = (+)
	(^-^) = (-)
	neg = negate

instance Group g => Group (a -> g) where
	zero = const zero
	(^+^) = liftA2 (^+^)
	(^-^) = liftA2 (^-^)
	neg = fmap neg

instance (Ord k, Group g) => Group (M.Map k g) where
	zero = M.empty
	(^+^) = M.unionWith (^+^)
	neg = fmap neg

instance Group g => Group (IM.IntMap g) where
	zero = IM.empty
	(^+^) = IM.unionWith (^+^)
	neg = fmap neg

instance Group g => Group (Poly g) where
	zero = []
	[] ^+^ p = p
	p ^+^ [] = p
	(a:as) ^+^ (b:bs) = (a ^+^ b):(as ^+^ bs)

instance (Group g1, Group g2) => Group (g1, g2) where
	{-# SPECIALIZE instance Group g => Group (g, g) #-}
	zero = (zero, zero)
	(x1, y1) ^+^ (x2, y2) = (x1 ^+^ x2, y1 ^+^ y2)
	(x1, y1) ^-^ (x2, y2) = (x1 ^-^ x2, y1 ^-^ y2)
	neg (x, y) = (neg x, neg y)

instance (Group g1, Group g2, Group g3) => Group (g1, g2, g3) where
	{-# SPECIALIZE instance Group g => Group (g, g, g) #-}
	zero = (zero, zero, zero)
	(x1, y1, z1) ^+^ (x2, y2, z2) = (x1 ^+^ x2, y1 ^+^ y2, z1 ^+^ z2)
	(x1, y1, z1) ^-^ (x2, y2, z2) = (x1 ^-^ x2, y1 ^-^ y2, z1 ^-^ z2)
	neg (x, y, z) = (neg x, neg y, neg z)

instance (Group g1, Group g2, Group g3, Group g4) => Group (g1, g2, g3, g4) where
	{-# SPECIALIZE instance Group g => Group (g, g, g, g) #-}
	zero = (zero, zero, zero, zero)
	(x1, y1, z1, w1) ^+^ (x2, y2, z2, w2) = (x1 ^+^ x2, y1 ^+^ y2, z1 ^+^ z2, w1 ^+^ w2)
	(x1, y1, z1, w1) ^-^ (x2, y2, z2, w2) = (x1 ^-^ x2, y1 ^-^ y2, z1 ^-^ z2, w1 ^-^ w2)
	neg (x, y, z, w) = (neg x, neg y, neg z, neg w)

{-# INLINE gsum #-}
-- | Does a summation over the elements of a group.
gsum :: Group g => [g] -> g
gsum = foldr (^+^) zero