module Math.LinearMap.Category.Instances where
import Math.LinearMap.Category.Class
import Data.VectorSpace
import Data.Basis
import Math.Manifold.Core.PseudoAffine
import Prelude ()
import qualified Prelude as Hask
import Control.Category.Constrained.Prelude
import Control.Arrow.Constrained
import Data.Coerce
import Data.Type.Coercion
import Data.Tagged
import Data.Foldable (foldl')
import Data.VectorSpace.Free
import Data.VectorSpace.Free.FiniteSupportedSequence
import Data.VectorSpace.Free.Sequence as Seq
import qualified Linear.Matrix as Mat
import qualified Linear.Vector as Mat
import qualified Linear.Metric as Mat
import Linear ( V0(V0), V1(V1), V2(V2), V3(V3), V4(V4)
, _x, _y, _z, _w )
import Control.Lens ((^.))
import qualified Data.Vector as Arr
import qualified Data.Vector.Unboxed as UArr
import Math.LinearMap.Asserted
import Math.VectorSpace.ZeroDimensional
import qualified GHC.Exts as GHC
infixr 7 <.>^
(<.>^) :: LinearSpace v => DualVector v -> v -> Scalar v
f<.>^v = (applyDualVector-+$>f)-+$>v
type ℝ = Double
instance Num' ℝ where
closedScalarWitness = ClosedScalarWitness
instance TensorSpace ℝ where
type TensorProduct ℝ w = w
scalarSpaceWitness = ScalarSpaceWitness
linearManifoldWitness = LinearManifoldWitness BoundarylessWitness
zeroTensor = Tensor zeroV
scaleTensor = bilinearFunction $ \μ (Tensor t) -> Tensor $ μ*^t
addTensors (Tensor v) (Tensor w) = Tensor $ v ^+^ w
subtractTensors (Tensor v) (Tensor w) = Tensor $ v ^-^ w
negateTensor = pretendLike Tensor lNegateV
toFlatTensor = follow Tensor
fromFlatTensor = flout Tensor
tensorProduct = LinearFunction $ \μ -> follow Tensor . scaleWith μ
transposeTensor = toFlatTensor . flout Tensor
fmapTensor = LinearFunction $ pretendLike Tensor
fzipTensorWith = LinearFunction
$ \f -> follow Tensor <<< f <<< flout Tensor *** flout Tensor
coerceFmapTensorProduct _ Coercion = Coercion
wellDefinedTensor (Tensor w) = Tensor <$> wellDefinedVector w
instance LinearSpace ℝ where
type DualVector ℝ = ℝ
dualSpaceWitness = DualSpaceWitness
linearId = LinearMap 1
tensorId = uncurryLinearMap $ LinearMap $ fmap (follow Tensor) -+$> id
idTensor = Tensor 1
fromLinearForm = flout LinearMap
coerceDoubleDual = Coercion
contractTensorMap = flout Tensor . flout LinearMap
contractMapTensor = flout LinearMap . flout Tensor
applyDualVector = scale
applyLinear = LinearFunction $ \(LinearMap w) -> scaleV w
applyTensorFunctional = bilinearFunction $ \(LinearMap du) (Tensor u) -> du<.>^u
applyTensorLinMap = bilinearFunction $ \fℝuw (Tensor u)
-> let LinearMap fuw = curryLinearMap $ fℝuw
in (applyLinear-+$>fuw) -+$> u
composeLinear = bilinearFunction $ \f (LinearMap g)
-> LinearMap $ (applyLinear-+$>f)-+$>g
#define FreeLinearSpace(V, LV, tp, tenspl, tenid, dspan, contraction, contraaction) \
instance Num s => Semimanifold (V s) where { \
type Needle (V s) = V s; \
toInterior = pure; fromInterior = id; \
(.+~^) = (^+^); \
translateP = Tagged (^+^) }; \
instance Num s => PseudoAffine (V s) where { \
v.-~.w = pure (v^-^w); (.-~!) = (^-^) }; \
instance ∀ s . (Num' s, Eq s) => TensorSpace (V s) where { \
type TensorProduct (V s) w = V w; \
scalarSpaceWitness = case closedScalarWitness :: ClosedScalarWitness s of{ \
ClosedScalarWitness -> ScalarSpaceWitness}; \
linearManifoldWitness = LinearManifoldWitness BoundarylessWitness; \
zeroTensor = Tensor $ pure zeroV; \
addTensors (Tensor m) (Tensor n) = Tensor $ liftA2 (^+^) m n; \
subtractTensors (Tensor m) (Tensor n) = Tensor $ liftA2 (^-^) m n; \
negateTensor = LinearFunction $ Tensor . fmap negateV . getTensorProduct; \
scaleTensor = bilinearFunction \
$ \μ -> Tensor . fmap (μ*^) . getTensorProduct; \
toFlatTensor = case closedScalarWitness :: ClosedScalarWitness s of{ \
ClosedScalarWitness -> follow Tensor}; \
fromFlatTensor = case closedScalarWitness :: ClosedScalarWitness s of{ \
ClosedScalarWitness -> flout Tensor}; \
tensorProduct = bilinearFunction $ \w v -> Tensor $ fmap (*^v) w; \
transposeTensor = LinearFunction (tp); \
fmapTensor = bilinearFunction $ \
\(LinearFunction f) -> pretendLike Tensor $ fmap f; \
fzipTensorWith = bilinearFunction $ \
\(LinearFunction f) (Tensor vw, Tensor vx) \
-> Tensor $ liftA2 (curry f) vw vx; \
coerceFmapTensorProduct _ Coercion = Coercion; \
wellDefinedTensor = getTensorProduct >>> Hask.traverse wellDefinedVector \
>>> fmap Tensor }; \
instance ∀ s . (Num' s, Eq s) => LinearSpace (V s) where { \
type DualVector (V s) = V s; \
dualSpaceWitness = case closedScalarWitness :: ClosedScalarWitness s of \
{ClosedScalarWitness -> DualSpaceWitness}; \
linearId = LV Mat.identity; \
idTensor = Tensor Mat.identity; \
tensorId = ti dualSpaceWitness where \
{ ti :: ∀ w . (LinearSpace w, Scalar w ~ s) => DualSpaceWitness w -> (V s⊗w)+>(V s⊗w) \
; ti DualSpaceWitness = LinearMap $ \
fmap (\f -> fmap (LinearFunction $ Tensor . f)-+$>asTensor $ id) \
(tenid :: V (w -> V w)) }; \
coerceDoubleDual = Coercion; \
fromLinearForm = case closedScalarWitness :: ClosedScalarWitness s of{ \
ClosedScalarWitness -> flout LinearMap}; \
contractTensorMap = LinearFunction $ (contraction) . coerce . getLinearMap; \
contractMapTensor = LinearFunction $ (contraction) . coerce . getTensorProduct; \
\
contractLinearMapAgainst = bilinearFunction $ getLinearMap >>> (contraaction); \
applyDualVector = bilinearFunction Mat.dot; \
applyLinear = bilinearFunction $ \(LV m) \
-> foldl' (^+^) zeroV . liftA2 (^*) m; \
applyTensorFunctional = bilinearFunction $ \(LinearMap f) (Tensor t) \
-> sum $ liftA2 (<.>^) f t; \
applyTensorLinMap = bilinearFunction $ \(LinearMap f) (Tensor t) \
-> foldl' (^+^) zeroV $ liftA2 (arr fromTensor >>> \
getLinearFunction . getLinearFunction applyLinear) f t; \
composeLinear = bilinearFunction $ \
\f (LinearMap g) -> LinearMap $ fmap ((applyLinear-+$>f)-+$>) g }
FreeLinearSpace( V0
, LinearMap
, \(Tensor V0) -> zeroV
, \_ -> LinearMap V0
, V0
, LinearMap V0
, \V0 -> zeroV
, \V0 _ -> 0 )
FreeLinearSpace( V1
, LinearMap
, \(Tensor (V1 w₀)) -> w₀⊗V1 1
, \w -> LinearMap $ V1 (Tensor $ V1 w)
, V1 V1
, LinearMap . V1 . blockVectSpan $ V1 1
, \(V1 (V1 w)) -> w
, \(V1 x) f -> (f$x)^._x )
FreeLinearSpace( V2
, LinearMap
, \(Tensor (V2 w₀ w₁)) -> w₀⊗V2 1 0
^+^ w₁⊗V2 0 1
, \w -> LinearMap $ V2 (Tensor $ V2 w zeroV)
(Tensor $ V2 zeroV w)
, V2 (`V2`zeroV) (V2 zeroV)
, LinearMap $ V2 (blockVectSpan $ V2 1 0)
(blockVectSpan $ V2 0 1)
, \(V2 (V2 w₀ _)
(V2 _ w₁)) -> w₀^+^w₁
, \(V2 x y) f -> (f$x)^._x + (f$y)^._y )
FreeLinearSpace( V3
, LinearMap
, \(Tensor (V3 w₀ w₁ w₂)) -> w₀⊗V3 1 0 0
^+^ w₁⊗V3 0 1 0
^+^ w₂⊗V3 0 0 1
, \w -> LinearMap $ V3 (Tensor $ V3 w zeroV zeroV)
(Tensor $ V3 zeroV w zeroV)
(Tensor $ V3 zeroV zeroV w)
, V3 (\w -> V3 w zeroV zeroV)
(\w -> V3 zeroV w zeroV)
(\w -> V3 zeroV zeroV w)
, LinearMap $ V3 (blockVectSpan $ V3 1 0 0)
(blockVectSpan $ V3 0 1 0)
(blockVectSpan $ V3 0 0 1)
, \(V3 (V3 w₀ _ _)
(V3 _ w₁ _)
(V3 _ _ w₂)) -> w₀^+^w₁^+^w₂
, \(V3 x y z) f -> (f$x)^._x + (f$y)^._y + (f$z)^._z )
FreeLinearSpace( V4
, LinearMap
, \(Tensor (V4 w₀ w₁ w₂ w₃)) -> w₀⊗V4 1 0 0 0
^+^ w₁⊗V4 0 1 0 0
^+^ w₂⊗V4 0 0 1 0
^+^ w₃⊗V4 0 0 0 1
, \w -> V4 (LinearMap $ V4 w zeroV zeroV zeroV)
(LinearMap $ V4 zeroV w zeroV zeroV)
(LinearMap $ V4 zeroV zeroV w zeroV)
(LinearMap $ V4 zeroV zeroV zeroV w)
, V4 (\w -> V4 w zeroV zeroV zeroV)
(\w -> V4 zeroV w zeroV zeroV)
(\w -> V4 zeroV zeroV w zeroV)
(\w -> V4 zeroV zeroV zeroV w)
, LinearMap $ V4 (blockVectSpan $ V4 1 0 0 0)
(blockVectSpan $ V4 0 1 0 0)
(blockVectSpan $ V4 0 0 1 0)
(blockVectSpan $ V4 0 0 0 1)
, \(V4 (V4 w₀ _ _ _)
(V4 _ w₁ _ _)
(V4 _ _ w₂ _)
(V4 _ _ _ w₃)) -> w₀^+^w₁^+^w₂^+^w₃
, \(V4 x y z w) f -> (f$x)^._x + (f$y)^._y + (f$z)^._z + (f$w)^._w )
instance (Num' n, TensorProduct (DualVector n) n ~ n) => Num (LinearMap n n n) where
LinearMap n + LinearMap m = LinearMap $ n + m
LinearMap n LinearMap m = LinearMap $ n m
LinearMap n * LinearMap m = LinearMap $ n * m
abs (LinearMap n) = LinearMap $ abs n
signum (LinearMap n) = LinearMap $ signum n
fromInteger = LinearMap . fromInteger
instance (Fractional' n, TensorProduct (DualVector n) n ~ n)
=> Fractional (LinearMap n n n) where
LinearMap n / LinearMap m = LinearMap $ n / m
recip (LinearMap n) = LinearMap $ recip n
fromRational = LinearMap . fromRational
instance (Num' n, UArr.Unbox n) => Semimanifold (FinSuppSeq n) where
type Needle (FinSuppSeq n) = FinSuppSeq n
(.+~^) = (.+^); translateP = Tagged (.+^)
toInterior = pure; fromInterior = id
instance (Num' n, UArr.Unbox n) => PseudoAffine (FinSuppSeq n) where
v.-~.w = Just $ v.-.w; (.-~!) = (.-.)
instance (Num' n, UArr.Unbox n) => TensorSpace (FinSuppSeq n) where
type TensorProduct (FinSuppSeq n) v = [v]
wellDefinedVector (FinSuppSeq v) = FinSuppSeq <$> UArr.mapM wellDefinedVector v
scalarSpaceWitness = case closedScalarWitness :: ClosedScalarWitness n of
ClosedScalarWitness -> ScalarSpaceWitness
linearManifoldWitness = LinearManifoldWitness BoundarylessWitness
zeroTensor = Tensor []
toFlatTensor = LinearFunction $ Tensor . UArr.toList . getFiniteSeq
fromFlatTensor = LinearFunction $ FinSuppSeq . UArr.fromList . getTensorProduct
addTensors (Tensor s) (Tensor t) = Tensor $ Mat.liftU2 (^+^) s t
scaleTensor = bilinearFunction $ \μ (Tensor t) -> Tensor $ (μ*^)<$>t
negateTensor = LinearFunction $ \(Tensor t) -> Tensor $ negateV<$>t
tensorProduct = bilinearFunction
$ \(FinSuppSeq v) w -> Tensor $ (*^w)<$>UArr.toList v
transposeTensor = LinearFunction $ \(Tensor a)
-> let n = length a
in foldl' (^+^) zeroV
$ zipWith ( \i w -> getLinearFunction tensorProduct w $ basisValue i )
[0..] a
fmapTensor = bilinearFunction $ \f (Tensor a) -> Tensor $ map (f$) a
fzipTensorWith = bilinearFunction $ \f (Tensor a, Tensor b)
-> Tensor $ zipWith (curry $ arr f) a b
coerceFmapTensorProduct _ Coercion = Coercion
wellDefinedTensor (Tensor a) = Tensor <$> Hask.traverse wellDefinedVector a
instance (Num' n, UArr.Unbox n) => Semimanifold (Sequence n) where
type Needle (Sequence n) = Sequence n
(.+~^) = (.+^); translateP = Tagged (.+^)
toInterior = pure; fromInterior = id
instance (Num' n, UArr.Unbox n) => PseudoAffine (Sequence n) where
v.-~.w = Just $ v.-.w; (.-~!) = (.-.)
instance (Num' n, UArr.Unbox n) => TensorSpace (Sequence n) where
type TensorProduct (Sequence n) v = [v]
wellDefinedVector (SoloChunk n c) = SoloChunk n <$> UArr.mapM wellDefinedVector c
wellDefinedVector (Sequence h r) = Sequence <$> UArr.mapM wellDefinedVector h
<*> wellDefinedVector r
wellDefinedTensor (Tensor a) = Tensor <$> Hask.traverse wellDefinedVector a
scalarSpaceWitness = case closedScalarWitness :: ClosedScalarWitness n of
ClosedScalarWitness -> ScalarSpaceWitness
linearManifoldWitness = LinearManifoldWitness BoundarylessWitness
zeroTensor = Tensor []
toFlatTensor = LinearFunction $ Tensor . GHC.toList
fromFlatTensor = LinearFunction $ GHC.fromList . getTensorProduct
addTensors (Tensor s) (Tensor t) = Tensor $ Mat.liftU2 (^+^) s t
scaleTensor = bilinearFunction $ \μ (Tensor t) -> Tensor $ (μ*^)<$>t
negateTensor = LinearFunction $ \(Tensor t) -> Tensor $ negateV<$>t
tensorProduct = bilinearFunction
$ \v w -> Tensor $ (*^w)<$>GHC.toList v
transposeTensor = LinearFunction $ \(Tensor a)
-> let n = length a
in foldl' (^+^) zeroV
$ zipWith (\i w -> (getLinearFunction tensorProduct w) $ basisValue i)
[0..] a
fmapTensor = bilinearFunction $ \f (Tensor a) -> Tensor $ map (f$) a
fzipTensorWith = bilinearFunction $ \f (Tensor a, Tensor b)
-> Tensor $ zipWith (curry $ arr f) a b
coerceFmapTensorProduct _ Coercion = Coercion
instance (Num' n, UArr.Unbox n) => LinearSpace (Sequence n) where
type DualVector (Sequence n) = FinSuppSeq n
dualSpaceWitness = case closedScalarWitness :: ClosedScalarWitness n of
ClosedScalarWitness -> DualSpaceWitness
linearId = LinearMap [basisValue i | i<-[0..]]
tensorId = LinearMap [asTensor $ fmap (LinearFunction $
\w -> Tensor $ replicate (i1) zeroV ++ [w]) $ id | i<-[0..]]
applyDualVector = bilinearFunction $ adv Seq.minimumChunkSize
where adv _ (FinSuppSeq v) (Seq.SoloChunk o q)
= UArr.sum $ UArr.zipWith (*) (UArr.drop o v) q
adv chunkSize (FinSuppSeq v) (Sequence c r)
| UArr.length v > chunkSize
= UArr.sum (UArr.zipWith (*) v c)
+ adv (chunkSize*2) (FinSuppSeq $ UArr.drop chunkSize v) r
| otherwise = UArr.sum $ UArr.zipWith (*) v c
applyLinear = bilinearFunction $ apl Seq.minimumChunkSize
where apl _ (LinearMap m) (Seq.SoloChunk o q)
= sumV $ zipWith (*^) (UArr.toList q) (drop o m)
apl chunkSize (LinearMap m) (Sequence c r)
| null mr = sumV $ zipWith (*^) (UArr.toList c) mc
| otherwise = foldl' (^+^) (apl (chunkSize*2) (LinearMap mr) r)
(zipWith (*^) (UArr.toList c) mc)
where (mc, mr) = splitAt chunkSize m
applyTensorFunctional = bilinearFunction
$ \(LinearMap m) (Tensor t) -> sum $ zipWith (<.>^) m t
applyTensorLinMap = bilinearFunction $ arr curryLinearMap >>>
\(LinearMap m) (Tensor t)
-> sumV $ zipWith (getLinearFunction . getLinearFunction applyLinear) m t
instance (Num' n, UArr.Unbox n) => LinearSpace (FinSuppSeq n) where
type DualVector (FinSuppSeq n) = Sequence n
dualSpaceWitness = case closedScalarWitness :: ClosedScalarWitness n of
ClosedScalarWitness -> DualSpaceWitness
linearId = LinearMap [basisValue i | i<-[0..]]
tensorId = LinearMap [asTensor $ fmap (LinearFunction $
\w -> Tensor $ replicate (i1) zeroV ++ [w]) $ id | i<-[0..]]
applyDualVector = bilinearFunction $ adv Seq.minimumChunkSize
where adv _ (Seq.SoloChunk o q) (FinSuppSeq v)
= UArr.sum $ UArr.zipWith (*) q (UArr.drop o v)
adv chunkSize (Sequence c r) (FinSuppSeq v)
| UArr.length v > chunkSize
= UArr.sum (UArr.zipWith (*) c v)
+ adv (chunkSize*2) r (FinSuppSeq $ UArr.drop chunkSize v)
| otherwise = UArr.sum $ UArr.zipWith (*) c v
applyLinear = bilinearFunction $ \(LinearMap m) (FinSuppSeq v)
-> foldl' (^+^) zeroV $ zipWith (*^) (UArr.toList v) m
applyTensorFunctional = bilinearFunction
$ \(LinearMap m) (Tensor t) -> sum $ zipWith (<.>^) m t
applyTensorLinMap = bilinearFunction $ arr curryLinearMap >>>
\(LinearMap m) (Tensor t)
-> sumV $ zipWith (getLinearFunction . getLinearFunction applyLinear) m t
instance GHC.IsList (Tensor s (Sequence s) v) where
type Item (Tensor s (Sequence s) v) = v
fromList = Tensor
toList = getTensorProduct
instance GHC.IsList (Tensor s (FinSuppSeq s) v) where
type Item (Tensor s (FinSuppSeq s) v) = v
fromList = Tensor
toList = getTensorProduct
newtype SymmetricTensor s v
= SymTensor { getSymmetricTensor :: Tensor s v v }
deriving instance (Show (Tensor s v v)) => Show (SymmetricTensor s v)
instance (TensorSpace v, Scalar v ~ s) => AffineSpace (SymmetricTensor s v) where
type Diff (SymmetricTensor s v) = SymmetricTensor s v
(.+^) = (^+^)
(.-.) = (^-^)
instance (TensorSpace v, Scalar v ~ s) => AdditiveGroup (SymmetricTensor s v) where
SymTensor s ^+^ SymTensor t = SymTensor $ s ^+^ t
zeroV = SymTensor zeroV
negateV (SymTensor t) = SymTensor $ negateV t
instance (TensorSpace v, Scalar v ~ s)
=> VectorSpace (SymmetricTensor s v) where
type Scalar (SymmetricTensor s v) = s
μ *^ SymTensor f = SymTensor $ μ*^f
instance (TensorSpace v, Scalar v ~ s) => Semimanifold (SymmetricTensor s v) where
type Needle (SymmetricTensor s v) = SymmetricTensor s v
(.+~^) = (^+^)
fromInterior = id
toInterior = pure
translateP = Tagged (^+^)
instance (TensorSpace v, Scalar v ~ s) => PseudoAffine (SymmetricTensor s v) where
(.-~!) = (^-^)
instance (Num' s, TensorSpace v, Scalar v ~ s) => TensorSpace (SymmetricTensor s v) where
type TensorProduct (SymmetricTensor s v) x = Tensor s v (Tensor s v x)
wellDefinedVector (SymTensor t) = SymTensor <$> wellDefinedVector t
scalarSpaceWitness = case closedScalarWitness :: ClosedScalarWitness s of
ClosedScalarWitness -> ScalarSpaceWitness
linearManifoldWitness = LinearManifoldWitness BoundarylessWitness
zeroTensor = Tensor zeroV
toFlatTensor = case closedScalarWitness :: ClosedScalarWitness s of
ClosedScalarWitness -> LinearFunction $ \(SymTensor t)
-> Tensor $ fmap toFlatTensor $ t
fromFlatTensor = case closedScalarWitness :: ClosedScalarWitness s of
ClosedScalarWitness -> LinearFunction $ \(Tensor t)
-> SymTensor $ fmap fromFlatTensor $ t
addTensors (Tensor f) (Tensor g) = Tensor $ f^+^g
subtractTensors (Tensor f) (Tensor g) = Tensor $ f^-^g
negateTensor = LinearFunction $ \(Tensor f) -> Tensor $ negateV f
scaleTensor = bilinearFunction $ \μ (Tensor f) -> Tensor $ μ *^ f
tensorProduct = bilinearFunction $ \(SymTensor t) g
-> Tensor $ fmap (LinearFunction (⊗g)) $ t
transposeTensor = LinearFunction $ \(Tensor f) -> getLinearFunction (
arr (fmap Coercion) . transposeTensor . arr lassocTensor) f
fmapTensor = bilinearFunction $ \f (Tensor t) -> Tensor $ fmap (fmap f) $ t
fzipTensorWith = bilinearFunction $ \f (Tensor s, Tensor t)
-> Tensor $ fzipWith (fzipWith f) $ (s,t)
coerceFmapTensorProduct _ crc = fmap (fmap crc)
wellDefinedTensor (Tensor t) = Tensor <$> wellDefinedVector t
instance (Num' s, LinearSpace v, Scalar v ~ s) => LinearSpace (SymmetricTensor s v) where
type DualVector (SymmetricTensor s v) = SymmetricTensor s (DualVector v)
dualSpaceWitness = case ( closedScalarWitness :: ClosedScalarWitness s
, dualSpaceWitness :: DualSpaceWitness v ) of
(ClosedScalarWitness, DualSpaceWitness) -> DualSpaceWitness
linearId = case dualSpaceWitness :: DualSpaceWitness v of
DualSpaceWitness -> LinearMap $ rassocTensor . asTensor
. fmap (follow SymTensor . asTensor) $ id
tensorId = LinearMap $ asTensor . fmap asTensor . curryLinearMap
. fmap asTensor
. curryLinearMap
. fmap (follow $ \t -> Tensor $ rassocTensor $ t)
$ id
applyLinear = case dualSpaceWitness :: DualSpaceWitness v of
DualSpaceWitness -> bilinearFunction $ \(LinearMap f) (SymTensor t)
-> (getLinearFunction applyLinear
$ fromTensor . deferLinearMap . asLinearMap $ f) $ t
applyDualVector = bilinearFunction $ \(SymTensor f) (SymTensor v)
-> getLinearFunction
(getLinearFunction applyDualVector $ fromTensor $ f) v
applyTensorFunctional = case dualSpaceWitness :: DualSpaceWitness v of
DualSpaceWitness -> bilinearFunction $ \(LinearMap f) (Tensor t)
-> getLinearFunction
(getLinearFunction applyTensorFunctional
$ fromTensor . fmap fromTensor $ f) t
applyTensorLinMap = case dualSpaceWitness :: DualSpaceWitness v of
DualSpaceWitness -> bilinearFunction $ \(LinearMap (Tensor f)) (Tensor t)
-> getLinearFunction (getLinearFunction applyTensorLinMap
$ uncurryLinearMap
. fmap (uncurryLinearMap . fromTensor . fmap fromTensor)
$ LinearMap f) t
squareV :: (Num' s, s ~ Scalar v)
=> TensorSpace v => v -> SymmetricTensor s v
squareV v = SymTensor $ v⊗v
squareVs :: (Num' s, s ~ Scalar v)
=> TensorSpace v => [v] -> SymmetricTensor s v
squareVs vs = SymTensor $ tensorProducts [(v,v) | v<-vs]
type v⊗〃+>w = LinearMap (Scalar v) (SymmetricTensor (Scalar v) v) w
currySymBilin :: LinearSpace v => (v⊗〃+>w) -+> (v+>(v+>w))
currySymBilin = LinearFunction . arr $ fmap fromTensor . fromTensor . flout LinearMap