module Math.LinearMap.Category.Derivatives
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 (\m -> fmap (LinearFunction (^.𝑣))
$ m . arr (LinearFunction $ \q -> zeroV & 𝑞.~q))
(\m u -> arr.LinearFunction
$ \x -> (m $ x & 𝑞.~zeroV)
^+^ (𝑣.~(u $ x^.𝑞) $ m $ zeroV & 𝑞.~(x^.𝑞)) )
(*∂) :: ∀ 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*∂𝑚 = lens (\a -> a^.𝑚 $ q)
(\a v -> (a & 𝑚 .~ arr (LinearFunction $ \q' -> 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
𝑤.∂𝑦 = case closedScalarWitness :: ClosedScalarWitness s of
ClosedScalarWitness -> lens
(\(SymTensor t)
-> (getTensorProduct $ fmap (LinearFunction (^.𝑦)) $ t)^.𝑤 ^* 0.5)
(\(SymTensor (Tensor t)) z -> SymTensor . Tensor $ (𝑤.𝑦.~z^*2) t)