-- |
-- Module      : Math.LinearMap.Category.Derivatives
-- Copyright   : (c) Justus Sagemüller 2016
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE Rank2Types                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE ViewPatterns               #-}
{-# LANGUAGE UnicodeSyntax              #-}
{-# LANGUAGE TupleSections              #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE DefaultSignatures          #-}

module Math.LinearMap.Category.Derivatives
    {-# WARNING "These lenses will probably change their domain in the future." #-} where

import Data.VectorSpace
import Data.VectorSpace.Free

import Prelude ()
import qualified Prelude as Hask

import Control.Category.Constrained.Prelude
import Control.Arrow.Constrained

import Data.Type.Coercion
import Data.Tagged

import Math.Manifold.Core.PseudoAffine
import Math.LinearMap.Asserted
import Math.LinearMap.Category.Instances
import Math.LinearMap.Category.Class

import Control.Lens

infixr 7 *∂, /∂, .∂
(/∂) :: ∀ s x y v q
          . ( Num' s, LinearSpace x, LinearSpace y, LinearSpace v, LinearSpace q
            , s ~ Scalar x, s ~ Scalar y, s ~ Scalar v, s ~ Scalar q )
       => Lens' y v -> Lens' x q -> Lens' (LinearMap s x y) (LinearMap s q v)
Lens' y v
𝑣/∂ :: forall s x y v q.
(Num' s, LinearSpace x, LinearSpace y, LinearSpace v,
 LinearSpace q, s ~ Scalar x, s ~ Scalar y, s ~ Scalar v,
 s ~ Scalar q) =>
Lens' y v -> Lens' x q -> Lens' (LinearMap s x y) (LinearMap s q v)
/∂Lens' x q
𝑞 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\LinearMap s x y
m -> forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.Lens' y v
𝑣))
                     forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap s x y
m forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \q
q -> forall v. AdditiveGroup v => v
zeroV forall a b. a -> (a -> b) -> b
& Lens' x q
𝑞forall s t a b. ASetter s t a b -> b -> s -> t
.~q
q))
            (\LinearMap s x y
m LinearMap s q v
u -> forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arrforall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction
               forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \x
x -> (LinearMap s x y
m forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x forall a b. a -> (a -> b) -> b
& Lens' x q
𝑞forall s t a b. ASetter s t a b -> b -> s -> t
.~forall v. AdditiveGroup v => v
zeroV)
                   forall v. AdditiveGroup v => v -> v -> v
^+^ (Lens' y v
𝑣forall s t a b. ASetter s t a b -> b -> s -> t
.~(LinearMap s q v
u forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
xforall s a. s -> Getting a s a -> a
^.Lens' x q
𝑞) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap s x y
m forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. AdditiveGroup v => v
zeroV forall a b. a -> (a -> b) -> b
& Lens' x q
𝑞forall s t a b. ASetter s t a b -> b -> s -> t
.~(x
xforall s a. s -> Getting a s a -> a
^.Lens' x q
𝑞)) )

(*∂) :: ∀ s a q v . ( Num' s, OneDimensional q, LinearSpace q, LinearSpace v
                   , s ~ Scalar a, s ~ Scalar q, s ~ Scalar v )
       => q -> Lens' a (LinearMap s q v) -> Lens' a v
q
q*∂ :: forall s a q v.
(Num' s, OneDimensional q, LinearSpace q, LinearSpace v,
 s ~ Scalar a, s ~ Scalar q, s ~ Scalar v) =>
q -> Lens' a (LinearMap s q v) -> Lens' a v
*∂Lens' a (LinearMap s q v)
𝑚 = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\a
a -> a
aforall s a. s -> Getting a s a -> a
^.Lens' a (LinearMap s q v)
𝑚 forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ q
q)
           (\a
a v
v -> (a
a forall a b. a -> (a -> b) -> b
& Lens' a (LinearMap s q v)
𝑚 forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \q
q' -> v
v forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* (q
q'forall v. OneDimensional v => v -> v -> Scalar v
^/!q
q))) )

(.∂) :: ∀ s x z . ( Fractional' s, LinearSpace x, s ~ Scalar x, LinearSpace z, s ~ Scalar z )
            => (∀ w . (LinearSpace w, Scalar w ~ s) => Lens' (TensorProduct x w) w)
                  -> Lens' x z -> Lens' (SymmetricTensor s x) z
forall w.
(LinearSpace w, Scalar w ~ s) =>
Lens' (TensorProduct x w) w
𝑤.∂ :: forall s x z.
(Fractional' s, LinearSpace x, s ~ Scalar x, LinearSpace z,
 s ~ Scalar z) =>
(forall w.
 (LinearSpace w, Scalar w ~ s) =>
 Lens' (TensorProduct x w) w)
-> Lens' x z -> Lens' (SymmetricTensor s x) z
.∂Lens' x z
𝑦 = case forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness s of
     ClosedScalarWitness s
ClosedScalarWitness -> forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
            (\(SymTensor Tensor s x x
t)
               -> (forall s v w. Tensor s v w -> TensorProduct v w
getTensorProduct forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (forall s a. s -> Getting a s a -> a
^.Lens' x z
𝑦)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Tensor s x x
t)forall s a. s -> Getting a s a -> a
^.forall w.
(LinearSpace w, Scalar w ~ s) =>
Lens' (TensorProduct x w) w
𝑤 forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* s
0.5)
            (\(SymTensor (Tensor TensorProduct x x
t)) z
z -> forall s v. Tensor s v v -> SymmetricTensor s v
SymTensor forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. TensorProduct v w -> Tensor s v w
Tensor forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (forall w.
(LinearSpace w, Scalar w ~ s) =>
Lens' (TensorProduct x w) w
𝑤forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.Lens' x z
𝑦forall s t a b. ASetter s t a b -> b -> s -> t
.~z
zforall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*s
2) TensorProduct x x
t)