-- | -- Module : Math.LinearMap.Category.Instances -- Copyright : (c) Justus Sagemüller 2016 -- License : GPL v3 -- -- Maintainer : (@) sagemueller $ geo.uni-koeln.de -- Stability : experimental -- Portability : portable -- {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UnicodeSyntax #-} {-# LANGUAGE CPP #-} {-# LANGUAGE TupleSections #-} 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; \ {-contractTensorWith = bilinearFunction $ \ \(Tensor wv) dw -> fmap (arr $ applyDualVector $ dw) wv; -} \ 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 (i-1) 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 (i-1) 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