{-# LANGUAGE RebindableSyntax #-}
{- |
Copyright   :  (c) Henning Thielemann 2004-2005

Maintainer  :  numericprelude@henning-thielemann.de
Stability   :  provisional
Portability :  portable

Abstraction of vectors
-}

module Algebra.Vector where

import qualified Algebra.Ring     as Ring
import qualified Algebra.Additive as Additive

import Algebra.Ring     ((*))
import Algebra.Additive ((+))

import Data.List (zipWith, foldl)

import Prelude((.), (==), Bool, Functor, fmap)
import qualified Prelude as P


-- Is this right?
infixr 7 *>

{-|
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 C v where
    -- duplicate some methods from Additive
    -- | zero element of the vector space
    zero  :: (Additive.C a) => v a
    -- | add and subtract elements
    (<+>) :: (Additive.C a) => v a -> v a -> v a
    -- | scale a vector by a scalar
    (*>)  :: (Ring.C a) => a -> v a -> v a

infixl 6 <+>


{- |
We need a Haskell 98 type class
which provides equality test for Vector type constructors.
-}
class Eq v where
   eq :: P.Eq a => v a -> v a -> Bool


infix 4 `eq`


{-* Instances for standard type constructors -}

functorScale :: (Functor v, Ring.C a) => a -> v a -> v a
functorScale :: a -> v a -> v a
functorScale = (a -> a) -> v a -> v a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> a) -> v a -> v a) -> (a -> a -> a) -> a -> v a -> v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
forall a. C a => a -> a -> a
(*)

instance C [] where
   zero :: [a]
zero  = [a]
forall a. C a => a
Additive.zero
   <+> :: [a] -> [a] -> [a]
(<+>) = [a] -> [a] -> [a]
forall a. C a => a -> a -> a
(Additive.+)
   *> :: a -> [a] -> [a]
(*>)  = a -> [a] -> [a]
forall (v :: * -> *) a. (Functor v, C a) => a -> v a -> v a
functorScale

instance C ((->) b) where
   zero :: b -> a
zero     = b -> a
forall a. C a => a
Additive.zero
   <+> :: (b -> a) -> (b -> a) -> b -> a
(<+>)    = (b -> a) -> (b -> a) -> b -> a
forall a. C a => a -> a -> a
(Additive.+)
   *> :: a -> (b -> a) -> b -> a
(*>) a
s b -> a
f = (a
sa -> a -> a
forall a. C a => a -> a -> a
*) (a -> a) -> (b -> a) -> b -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f

instance Eq [] where
   eq :: [a] -> [a] -> Bool
eq = [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
(==)



{-* Related functions -}

{-|
Compute the linear combination of a list of vectors.
-}
linearComb :: (Ring.C a, C v) => [a] -> [v a] -> v a
linearComb :: [a] -> [v a] -> v a
linearComb [a]
c = (v a -> v a -> v a) -> v a -> [v a] -> v a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl v a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => v a -> v a -> v a
(<+>) v a
forall (v :: * -> *) a. (C v, C a) => v a
zero ([v a] -> v a) -> ([v a] -> [v a]) -> [v a] -> v a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> v a -> v a) -> [a] -> [v a] -> [v a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
(*>) [a]
c


{- * Properties -}

propCascade :: (C v, Eq v, Ring.C a, P.Eq a) =>
   a -> a -> v a -> Bool
propCascade :: a -> a -> v a -> Bool
propCascade a
a a
b v a
c           = (a
a a -> a -> a
forall a. C a => a -> a -> a
* a
b) a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*> v a
c  v a -> v a -> Bool
forall (v :: * -> *) a. (Eq v, Eq a) => v a -> v a -> Bool
`eq`  a
a a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*> (a
b a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*> v a
c)

propRightDistributive :: (C v, Eq v, Ring.C a, P.Eq a) =>
   a -> v a -> v a -> Bool
propRightDistributive :: a -> v a -> v a -> Bool
propRightDistributive a
a v a
b v a
c =   a
a a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*> (v a
b v a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => v a -> v a -> v a
<+> v a
c)  v a -> v a -> Bool
forall (v :: * -> *) a. (Eq v, Eq a) => v a -> v a -> Bool
`eq`  a
aa -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*>v a
b v a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => v a -> v a -> v a
<+> a
aa -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*>v a
c

propLeftDistributive :: (C v, Eq v, Ring.C a, P.Eq a) =>
   a -> a -> v a -> Bool
propLeftDistributive :: a -> a -> v a -> Bool
propLeftDistributive a
a a
b v a
c  =   (a
aa -> a -> a
forall a. C a => a -> a -> a
+a
b) a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*> v a
c  v a -> v a -> Bool
forall (v :: * -> *) a. (Eq v, Eq a) => v a -> v a -> Bool
`eq`  a
aa -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*>v a
c v a -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => v a -> v a -> v a
<+> a
ba -> v a -> v a
forall (v :: * -> *) a. (C v, C a) => a -> v a -> v a
*>v a
c