{-# LANGUAGE RebindableSyntax #-}
{-# 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, sum, )

import qualified NumericPrelude.Elementwise as Elem
import Control.Applicative (Applicative(pure, (<*>)), )

import qualified Data.Complex as Complex98
import Data.Int (Int, Int8, Int16, Int32, Int64, )

import Data.Function.HT (powerAssociative, )
import Data.List (map, zipWith, )
import Data.Tuple.HT (fst3, snd3, thd3, )
import Data.Tuple (fst, snd, )

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


-- Is this right?
infixr 7 *>

{-
Functional dependency can't be used
since @Complex.T a@ is a module
with respect to both @a@ and @Complex.T a@.

class Algebra.Module.C a v | v -> 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 (Ring.C a, Additive.C v) => C a v where
    -- | scale a vector by a scalar
    (*>) :: a -> v -> v


{-# INLINE (<*>.*>) #-}
(<*>.*>) ::
   (C a x) =>
   Elem.T (a,v) (x -> c) -> (v -> x) -> Elem.T (a,v) c
<*>.*> :: T (a, v) (x -> c) -> (v -> x) -> T (a, v) c
(<*>.*>) T (a, v) (x -> c)
f v -> x
acc =
   T (a, v) (x -> c)
f T (a, v) (x -> c) -> T (a, v) x -> T (a, v) c
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((a, v) -> x) -> T (a, v) x
forall v a. (v -> a) -> T v a
Elem.element (\(a
a,v
v) -> a
a a -> x -> x
forall a v. C a v => a -> v -> v
*> v -> x
acc v
v)



{-* Instances for atomic types -}

instance C Float Float where
   {-# INLINE (*>) #-}
   *> :: Float -> Float -> Float
(*>) = Float -> Float -> Float
forall a. C a => a -> a -> a
(*)

instance C Double Double where
   {-# INLINE (*>) #-}
   *> :: Double -> Double -> Double
(*>) = Double -> Double -> Double
forall a. C a => a -> a -> a
(*)

instance C Int Int where
   {-# INLINE (*>) #-}
   *> :: Int -> Int -> Int
(*>) = Int -> Int -> Int
forall a. C a => a -> a -> a
(*)

instance C Int8 Int8 where
   {-# INLINE (*>) #-}
   *> :: Int8 -> Int8 -> Int8
(*>) = Int8 -> Int8 -> Int8
forall a. C a => a -> a -> a
(*)

instance C Int16 Int16 where
   {-# INLINE (*>) #-}
   *> :: Int16 -> Int16 -> Int16
(*>) = Int16 -> Int16 -> Int16
forall a. C a => a -> a -> a
(*)

instance C Int32 Int32 where
   {-# INLINE (*>) #-}
   *> :: Int32 -> Int32 -> Int32
(*>) = Int32 -> Int32 -> Int32
forall a. C a => a -> a -> a
(*)

instance C Int64 Int64 where
   {-# INLINE (*>) #-}
   *> :: Int64 -> Int64 -> Int64
(*>) = Int64 -> Int64 -> Int64
forall a. C a => a -> a -> a
(*)

instance C Integer Integer where
   {-# INLINE (*>) #-}
   *> :: Integer -> Integer -> Integer
(*>) = Integer -> Integer -> Integer
forall a. C a => a -> a -> a
(*)

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

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



{-* Instances for composed types -}

instance (C a b0, C a b1) => C a (b0, b1) where
   {-# INLINE (*>) #-}
   *> :: a -> (b0, b1) -> (b0, b1)
(*>) = T (a, (b0, b1)) (b0, b1) -> a -> (b0, b1) -> (b0, b1)
forall x y a. T (x, y) a -> x -> y -> a
Elem.run2 (T (a, (b0, b1)) (b0, b1) -> a -> (b0, b1) -> (b0, b1))
-> T (a, (b0, b1)) (b0, b1) -> a -> (b0, b1) -> (b0, b1)
forall a b. (a -> b) -> a -> b
$ (b0 -> b1 -> (b0, b1)) -> T (a, (b0, b1)) (b0 -> b1 -> (b0, b1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,) T (a, (b0, b1)) (b0 -> b1 -> (b0, b1))
-> ((b0, b1) -> b0) -> T (a, (b0, b1)) (b1 -> (b0, b1))
forall a x v c.
C a x =>
T (a, v) (x -> c) -> (v -> x) -> T (a, v) c
<*>.*> (b0, b1) -> b0
forall a b. (a, b) -> a
fst T (a, (b0, b1)) (b1 -> (b0, b1))
-> ((b0, b1) -> b1) -> T (a, (b0, b1)) (b0, b1)
forall a x v c.
C a x =>
T (a, v) (x -> c) -> (v -> x) -> T (a, v) c
<*>.*> (b0, b1) -> b1
forall a b. (a, b) -> b
snd
   -- s *> (x0,x1)   = (s *> x0, s *> x1)

instance (C a b0, C a b1, C a b2) => C a (b0, b1, b2) where
   {-# INLINE (*>) #-}
   *> :: a -> (b0, b1, b2) -> (b0, b1, b2)
(*>) = T (a, (b0, b1, b2)) (b0, b1, b2)
-> a -> (b0, b1, b2) -> (b0, b1, b2)
forall x y a. T (x, y) a -> x -> y -> a
Elem.run2 (T (a, (b0, b1, b2)) (b0, b1, b2)
 -> a -> (b0, b1, b2) -> (b0, b1, b2))
-> T (a, (b0, b1, b2)) (b0, b1, b2)
-> a
-> (b0, b1, b2)
-> (b0, b1, b2)
forall a b. (a -> b) -> a -> b
$ (b0 -> b1 -> b2 -> (b0, b1, b2))
-> T (a, (b0, b1, b2)) (b0 -> b1 -> b2 -> (b0, b1, b2))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (,,) T (a, (b0, b1, b2)) (b0 -> b1 -> b2 -> (b0, b1, b2))
-> ((b0, b1, b2) -> b0)
-> T (a, (b0, b1, b2)) (b1 -> b2 -> (b0, b1, b2))
forall a x v c.
C a x =>
T (a, v) (x -> c) -> (v -> x) -> T (a, v) c
<*>.*> (b0, b1, b2) -> b0
forall a b c. (a, b, c) -> a
fst3 T (a, (b0, b1, b2)) (b1 -> b2 -> (b0, b1, b2))
-> ((b0, b1, b2) -> b1) -> T (a, (b0, b1, b2)) (b2 -> (b0, b1, b2))
forall a x v c.
C a x =>
T (a, v) (x -> c) -> (v -> x) -> T (a, v) c
<*>.*> (b0, b1, b2) -> b1
forall a b c. (a, b, c) -> b
snd3 T (a, (b0, b1, b2)) (b2 -> (b0, b1, b2))
-> ((b0, b1, b2) -> b2) -> T (a, (b0, b1, b2)) (b0, b1, b2)
forall a x v c.
C a x =>
T (a, v) (x -> c) -> (v -> x) -> T (a, v) c
<*>.*> (b0, b1, b2) -> b2
forall a b c. (a, b, c) -> c
thd3
   -- s *> (x0,x1,x2) = (s *> x0, s *> x1, s *> x2)

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

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


instance (C a b, P.RealFloat b) => C a (Complex98.Complex b) where
   {-# INLINE (*>) #-}
   a
s *> :: a -> Complex b -> Complex b
*> (b
x Complex98.:+ b
y)  =  (a
s a -> b -> b
forall a v. C a v => a -> v -> v
*> b
x) b -> b -> Complex b
forall a. a -> a -> Complex a
Complex98.:+ (a
s a -> b -> b
forall a v. C a v => a -> v -> v
*> b
y)


{-* Related functions -}

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

ToDo:
Should it use 'NumericPrelude.List.Checked.zipWith' ?
-}
linearComb :: C a v => [a] -> [v] -> v
linearComb :: [a] -> [v] -> v
linearComb [a]
c = [v] -> v
forall a. C a => [a] -> a
sum ([v] -> v) -> ([v] -> [v]) -> [v] -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> v -> v) -> [a] -> [v] -> [v]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> v -> v
forall a v. C a v => a -> v -> v
(*>) [a]
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 v) => a -> v -> v
integerMultiply :: a -> v -> v
integerMultiply a
a v
v =
   (v -> v -> v) -> v -> v -> Integer -> v
forall a. (a -> a -> a) -> a -> a -> Integer -> a
powerAssociative v -> v -> v
forall a. C a => a -> a -> a
(+) v
forall a. C a => a
zero v
v (a -> Integer
forall a. C a => a -> Integer
ToInteger.toInteger a
a)


{- * Properties -}

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

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

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