Module.hs

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, IncoherentInstances, TypeSynonymInstances #-}

module Data.Algebra.Module where

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

import Data.Algebra.Group
import Data.Algebra.Ring

-- | The algebraic structure of a module.  A vector space is a module with coefficients in a field.
class (Ring r, Group m) => Module r m where
	(*^) :: r -> m -> m

instance Module Int Int where
	(*^) = (*)

instance Module Integer Integer where
	(*^) = (*)

instance Module Int Integer where
	(*^) = (*) . fromIntegral

instance Integral a => Module Int (Ratio a) where
	{-# SPECIALIZE instance Module Int Rational #-}
	(*^) = (*) . fromIntegral

instance Integral a => Module Integer (Ratio a) where
	{-# SPECIALIZE instance Module Integer Rational #-}
	(*^) = (*) . fromIntegral

instance Integral a => Module (Ratio a) (Ratio a) where
	{-# SPECIALIZE instance Module Rational Rational #-}
	(*^) = (*)

instance Module Int Double where
	(*^) = (*) . fromIntegral

instance Module Integer Double where
	(*^) = (*) . fromIntegral

instance Integral a => Module (Ratio a) Double where
	{-# SPECIALIZE instance Module Rational Double #-}
	(*^) = (*) . realToFrac

instance Module Double Double where
	(*^) = (*)

instance (Ord g, Group g, Ring r) => Module (GroupRing r g) (GroupRing r g) where
	(*^) = (*#)

instance Module r m => Module r (a -> m) where
	(*^) = fmap . (*^)

instance (Ord k, Module r m) => Module r (M.Map k m) where
	(*^) = fmap . (*^)

instance Module r m => Module r (IM.IntMap m) where
	(*^) = fmap . (*^)

instance (Module r m1, Module r m2) => Module r (m1, m2) where
	{-# SPECIALIZE instance Module r m => Module r (m, m) #-}
	r *^ (a, b) = (r *^ a, r *^ b)

instance (Module r m1, Module r m2, Module r m3) => Module r (m1, m2, m3) where
	{-# SPECIALIZE instance Module r m => Module r (m, m, m) #-}
	r *^ (a, b, c) = (r *^ a, r *^ b, r *^ c)

instance (Module r m1, Module r m2, Module r m3, Module r m4) => Module r (m1, m2, m3, m4) where
	{-# SPECIALIZE instance Module r m => Module r (m, m, m, m) #-}
	r *^ (a, b, c, d) = (r *^ a, r *^ b, r *^ c, r *^ d)

-- | @'LinFunc' v c@ is a linear combination of variables of type @v@ with coefficients
-- from @c@.  Formally, this is the free @c@-module on @v@.  
type LinFunc = M.Map

-- | Given a variable @v@, returns the function equivalent to @v@.
var :: (Ord v, Num c) => v -> LinFunc v c
var v = M.singleton v 1

-- | @c '*&' v@ is equivalent to @c '*^' 'var' v@.
(*&) :: (Ord v, Num c) => c -> v -> LinFunc v c
c *& v = M.singleton v c

-- | Equivalent to @'vsum' . 'map' 'var'@.
varSum :: (Ord v, Ring c) => [v] -> LinFunc v c
varSum vs = M.fromList [(v, one) | v <- vs]

-- | Given a collection of vectors and scaling coefficients, returns this
-- linear combination.
combination :: Module r m => [(r, m)] -> m
combination xs = gsum [r *^ m | (r, m) <- xs]

{-# INLINE linCombination #-}
-- | Given a set of basic variables and coefficients, returns the linear combination obtained
-- by summing.
linCombination :: (Ord v, Num r) => [(r, v)] -> LinFunc v r
linCombination xs = M.fromListWith (+) [(v, r) | (r, v) <- xs]

-- | Substitution into a polynomial.
evalPoly :: (Module r m, Ring m) => Poly r -> m -> m
evalPoly f x = foldr (\ c z -> (c *^ one) ^+^ (x *# z)) zero f

{-# RULES
	"zero/*^" forall m . zero *^ m = zero;
	"*^/zero" forall r . r *^ zero = zero;
	"one/*^" forall m . one *^ m = m;
	#-}