{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |
Copyright   :  (c) Dylan Thurston, Henning Thielemann 2004-2005

Maintainer  :  numericprelude@henning-thielemann.de
Stability   :  provisional
Portability :  requires multi-parameter type classes

Abstraction of modules
-}

module Algebra.Module where

import qualified Number.Ratio as Ratio

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Ring      as Ring
import qualified Algebra.Additive  as Additive
import qualified Algebra.ToInteger as ToInteger

import qualified Algebra.Laws as Laws

import Algebra.Ring     ((*), fromInteger, )
import Algebra.Additive ((+), zero, )

import Data.Function.HT (powerAssociative, )
import Data.List (map, zipWith, foldl, )

import Prelude((.), Eq, Bool, Int, Integer, Float, Double)
-- import qualified Prelude as P


-- Is this right?
infixr 7 *>

{- Functional dependency can't be used
   since the instance (Algebra.Module.C a a)
   would conflict with all others.
   class Algebra.Module.C b a | b -> a where -}

{-|
A Module over a ring satisfies:

>   a *> (b + c) === a *> b + a *> c
>   (a * b) *> c === a *> (b *> c)
>   (a + b) *> c === a *> c + b *> c
-}
class (Additive.C b, Ring.C a) => C a b where
    -- | scale a vector by a scalar
    (*>) :: a -> b -> b

{-* Instances for atomic types -}

instance C Float Float where
   {-# INLINE (*>) #-}
   (*>) = (*)

instance C Double Double where
   {-# INLINE (*>) #-}
   (*>) = (*)

instance C Int Int where
   {-# INLINE (*>) #-}
   (*>) = (*)

instance C Integer Integer where
   {-# INLINE (*>) #-}
   (*>) = (*)

instance (PID.C a) => C (Ratio.T a) (Ratio.T a) where
   {-# INLINE (*>) #-}
   (*>) = (*)

instance (PID.C a) => C Integer (Ratio.T a) where
   {-# INLINE (*>) #-}
   x *> y = fromInteger x * y



{-* Instances for composed types -}

instance (C a b0, C a b1) => C a (b0, b1) where
   {-# INLINE (*>) #-}
   s *> (x0,x1)   = (s *> x0, s *> x1)

instance (C a b0, C a b1, C a b2) => C a (b0, b1, b2) where
   {-# INLINE (*>) #-}
   s *> (x0,x1,x2) = (s *> x0, s *> x1, s *> x2)

instance (C a b) => C a [b] where
   {-# INLINE (*>) #-}
   (*>) = map . (*>)

instance (C a b) => C a (c -> b) where
   {-# INLINE (*>) #-}
   (*>) s f = (*>) s . f


{-* Related functions -}

{-|
Compute the linear combination of a list of vectors.

ToDo:
Should it use 'NumericPrelude.List.zipWithMatch' ?
-}
linearComb :: C a b => [a] -> [b] -> b
linearComb c = foldl (+) zero . zipWith (*>) c

{-|
This function can be used to define any
'Additive.C' as a module over 'Integer'.

Better move to "Algebra.Additive"?
-}
{-# INLINE integerMultiply #-}
integerMultiply :: (ToInteger.C a, Additive.C b) => a -> b -> b
integerMultiply a b =
   powerAssociative (+) zero b (ToInteger.toInteger a)


{- * Properties -}

propCascade :: (Eq b, C a b) => b -> a -> a -> Bool
propCascade  =  Laws.leftCascade (*) (*>)

propRightDistributive :: (Eq b, C a b) => a -> b -> b -> Bool
propRightDistributive  =  Laws.rightDistributive (*>) (+)

propLeftDistributive :: (Eq b, C a b) => b -> a -> a -> Bool
propLeftDistributive x  =  Laws.homomorphism (*>x) (+) (+)