{-# LANGUAGE CPP, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- Operations on affine spaces.
-----------------------------------------------------------------------------
module Linear.Covector
  ( Covector(..)
  , ($*)
  ) where

import Control.Applicative
import Control.Monad
import Data.Functor.Plus hiding (zero)
import qualified Data.Functor.Plus as Plus
import Data.Functor.Bind
import Data.Functor.Rep as Rep
import Linear.Algebra

-- | Linear functionals from elements of an (infinite) free module to a scalar

newtype Covector r a = Covector { Covector r a -> (a -> r) -> r
runCovector :: (a -> r) -> r }

infixr 0 $*

($*) :: Representable f => Covector r (Rep f) -> f r -> r
Covector (Rep f -> r) -> r
f $* :: Covector r (Rep f) -> f r -> r
$* f r
m = (Rep f -> r) -> r
f (f r -> Rep f -> r
forall (f :: * -> *) a. Representable f => f a -> Rep f -> a
Rep.index f r
m)

instance Functor (Covector r) where
  fmap :: (a -> b) -> Covector r a -> Covector r b
fmap a -> b
f (Covector (a -> r) -> r
m) = ((b -> r) -> r) -> Covector r b
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((b -> r) -> r) -> Covector r b)
-> ((b -> r) -> r) -> Covector r b
forall a b. (a -> b) -> a -> b
$ \b -> r
k -> (a -> r) -> r
m (b -> r
k (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Apply (Covector r) where
  Covector ((a -> b) -> r) -> r
mf <.> :: Covector r (a -> b) -> Covector r a -> Covector r b
<.> Covector (a -> r) -> r
ma = ((b -> r) -> r) -> Covector r b
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((b -> r) -> r) -> Covector r b)
-> ((b -> r) -> r) -> Covector r b
forall a b. (a -> b) -> a -> b
$ \b -> r
k -> ((a -> b) -> r) -> r
mf (((a -> b) -> r) -> r) -> ((a -> b) -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a -> b
f -> (a -> r) -> r
ma (b -> r
k (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Applicative (Covector r) where
  pure :: a -> Covector r a
pure a
a = ((a -> r) -> r) -> Covector r a
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((a -> r) -> r) -> Covector r a)
-> ((a -> r) -> r) -> Covector r a
forall a b. (a -> b) -> a -> b
$ \a -> r
k -> a -> r
k a
a
  Covector ((a -> b) -> r) -> r
mf <*> :: Covector r (a -> b) -> Covector r a -> Covector r b
<*> Covector (a -> r) -> r
ma = ((b -> r) -> r) -> Covector r b
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((b -> r) -> r) -> Covector r b)
-> ((b -> r) -> r) -> Covector r b
forall a b. (a -> b) -> a -> b
$ \b -> r
k -> ((a -> b) -> r) -> r
mf (((a -> b) -> r) -> r) -> ((a -> b) -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a -> b
f -> (a -> r) -> r
ma ((a -> r) -> r) -> (a -> r) -> r
forall a b. (a -> b) -> a -> b
$ b -> r
k (b -> r) -> (a -> b) -> a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f

instance Bind (Covector r) where
  Covector (a -> r) -> r
m >>- :: Covector r a -> (a -> Covector r b) -> Covector r b
>>- a -> Covector r b
f = ((b -> r) -> r) -> Covector r b
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((b -> r) -> r) -> Covector r b)
-> ((b -> r) -> r) -> Covector r b
forall a b. (a -> b) -> a -> b
$ \b -> r
k -> (a -> r) -> r
m ((a -> r) -> r) -> (a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a
a -> Covector r b -> (b -> r) -> r
forall r a. Covector r a -> (a -> r) -> r
runCovector (a -> Covector r b
f a
a) b -> r
k

instance Monad (Covector r) where
#if !(MIN_VERSION_base(4,11,0))
  return a = Covector $ \k -> k a
#endif
  Covector (a -> r) -> r
m >>= :: Covector r a -> (a -> Covector r b) -> Covector r b
>>= a -> Covector r b
f = ((b -> r) -> r) -> Covector r b
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((b -> r) -> r) -> Covector r b)
-> ((b -> r) -> r) -> Covector r b
forall a b. (a -> b) -> a -> b
$ \b -> r
k -> (a -> r) -> r
m ((a -> r) -> r) -> (a -> r) -> r
forall a b. (a -> b) -> a -> b
$ \a
a -> Covector r b -> (b -> r) -> r
forall r a. Covector r a -> (a -> r) -> r
runCovector (a -> Covector r b
f a
a) b -> r
k

instance Num r => Alt (Covector r) where
  Covector (a -> r) -> r
m <!> :: Covector r a -> Covector r a -> Covector r a
<!> Covector (a -> r) -> r
n = ((a -> r) -> r) -> Covector r a
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((a -> r) -> r) -> Covector r a)
-> ((a -> r) -> r) -> Covector r a
forall a b. (a -> b) -> a -> b
$ \a -> r
k -> (a -> r) -> r
m a -> r
k r -> r -> r
forall a. Num a => a -> a -> a
+ (a -> r) -> r
n a -> r
k

instance Num r => Plus (Covector r) where
  zero :: Covector r a
zero = ((a -> r) -> r) -> Covector r a
forall r a. ((a -> r) -> r) -> Covector r a
Covector (r -> (a -> r) -> r
forall a b. a -> b -> a
const r
0)

instance Num r => Alternative (Covector r) where
  Covector (a -> r) -> r
m <|> :: Covector r a -> Covector r a -> Covector r a
<|> Covector (a -> r) -> r
n = ((a -> r) -> r) -> Covector r a
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((a -> r) -> r) -> Covector r a)
-> ((a -> r) -> r) -> Covector r a
forall a b. (a -> b) -> a -> b
$ \a -> r
k -> (a -> r) -> r
m a -> r
k r -> r -> r
forall a. Num a => a -> a -> a
+ (a -> r) -> r
n a -> r
k
  empty :: Covector r a
empty = ((a -> r) -> r) -> Covector r a
forall r a. ((a -> r) -> r) -> Covector r a
Covector (r -> (a -> r) -> r
forall a b. a -> b -> a
const r
0)

instance Num r => MonadPlus (Covector r) where
  Covector (a -> r) -> r
m mplus :: Covector r a -> Covector r a -> Covector r a
`mplus` Covector (a -> r) -> r
n = ((a -> r) -> r) -> Covector r a
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((a -> r) -> r) -> Covector r a)
-> ((a -> r) -> r) -> Covector r a
forall a b. (a -> b) -> a -> b
$ \a -> r
k -> (a -> r) -> r
m a -> r
k r -> r -> r
forall a. Num a => a -> a -> a
+ (a -> r) -> r
n a -> r
k
  mzero :: Covector r a
mzero = ((a -> r) -> r) -> Covector r a
forall r a. ((a -> r) -> r) -> Covector r a
Covector (r -> (a -> r) -> r
forall a b. a -> b -> a
const r
0)

instance Coalgebra r m => Num (Covector r m) where
  Covector (m -> r) -> r
f + :: Covector r m -> Covector r m -> Covector r m
+ Covector (m -> r) -> r
g = ((m -> r) -> r) -> Covector r m
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((m -> r) -> r) -> Covector r m)
-> ((m -> r) -> r) -> Covector r m
forall a b. (a -> b) -> a -> b
$ \m -> r
k -> (m -> r) -> r
f m -> r
k r -> r -> r
forall a. Num a => a -> a -> a
+ (m -> r) -> r
g m -> r
k
  Covector (m -> r) -> r
f - :: Covector r m -> Covector r m -> Covector r m
- Covector (m -> r) -> r
g = ((m -> r) -> r) -> Covector r m
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((m -> r) -> r) -> Covector r m)
-> ((m -> r) -> r) -> Covector r m
forall a b. (a -> b) -> a -> b
$ \m -> r
k -> (m -> r) -> r
f m -> r
k r -> r -> r
forall a. Num a => a -> a -> a
- (m -> r) -> r
g m -> r
k
  Covector (m -> r) -> r
f * :: Covector r m -> Covector r m -> Covector r m
* Covector (m -> r) -> r
g = ((m -> r) -> r) -> Covector r m
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((m -> r) -> r) -> Covector r m)
-> ((m -> r) -> r) -> Covector r m
forall a b. (a -> b) -> a -> b
$ \m -> r
k -> (m -> r) -> r
f ((m -> r) -> r) -> (m -> r) -> r
forall a b. (a -> b) -> a -> b
$ \m
m -> (m -> r) -> r
g ((m -> r) -> r) -> (m -> r) -> r
forall a b. (a -> b) -> a -> b
$ (m -> r) -> m -> m -> r
forall r m. Coalgebra r m => (m -> r) -> m -> m -> r
comult m -> r
k m
m
  negate :: Covector r m -> Covector r m
negate (Covector (m -> r) -> r
f) = ((m -> r) -> r) -> Covector r m
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((m -> r) -> r) -> Covector r m)
-> ((m -> r) -> r) -> Covector r m
forall a b. (a -> b) -> a -> b
$ \m -> r
k -> r -> r
forall a. Num a => a -> a
negate ((m -> r) -> r
f m -> r
k)
  abs :: Covector r m -> Covector r m
abs Covector r m
_    = [Char] -> Covector r m
forall a. HasCallStack => [Char] -> a
error [Char]
"Covector.abs: undefined"
  signum :: Covector r m -> Covector r m
signum Covector r m
_ = [Char] -> Covector r m
forall a. HasCallStack => [Char] -> a
error [Char]
"Covector.signum: undefined"
  fromInteger :: Integer -> Covector r m
fromInteger Integer
n = ((m -> r) -> r) -> Covector r m
forall r a. ((a -> r) -> r) -> Covector r a
Covector (((m -> r) -> r) -> Covector r m)
-> ((m -> r) -> r) -> Covector r m
forall a b. (a -> b) -> a -> b
$ \ m -> r
k -> Integer -> r
forall a. Num a => Integer -> a
fromInteger Integer
n r -> r -> r
forall a. Num a => a -> a -> a
* (m -> r) -> r
forall r m. Coalgebra r m => (m -> r) -> r
counital m -> r
k