linearmap-category 0.3.2.0 → 0.3.4.0

raw patch · 5 files changed

+734/−75 lines, 5 filesdep ~free-vector-spacesdep ~manifolds-coredep ~vector-spacePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: free-vector-spaces, manifolds-core, vector-space

API changes (from Hackage documentation)

Files

• Math/LinearMap/Category.hs +88/−31
• Math/LinearMap/Category/Class.hs +544/−39
• Math/LinearMap/Category/TensorQuot.hs +81/−0
• Math/VectorSpace/Docile.hs +16/−1
• linearmap-category.cabal +5/−4

@@ -59,7 +59,9 @@             , densifyNorm, wellDefinedNorm             -- * Solving linear equations             , (\$), pseudoInverse, roughDet-            , linearRegressionW, linearRegressionWVar+            , linearRegressionW, linearRegression+            , LinearRegressionResult+            , linearFit_χν², linearFit_bestModel, linearFit_modelUncertainty              -- * Eigenvalue problems             , eigen             , constructEigenSystem@@ -80,9 +82,9 @@             -- ** Tensors with basis decomposition             , (.⊗)             -- ** Hilbert space operations-            , DualSpace, riesz, coRiesz, showsPrecAsRiesz, (.<)+            , (·), DualSpace, riesz, coRiesz, showsPrecAsRiesz, (.<)             -- ** Constraint synonyms-            , HilbertSpace, SimpleSpace+            , HilbertSpace, SimpleSpace, RealSpace             , Num'(..)             , Fractional'             , RealFrac', RealFloat', LinearShowable@@ -96,13 +98,14 @@             , sharedNormSpanningSystem, sharedSeminormSpanningSystem             , sharedSeminormSpanningSystem'             , convexPolytopeHull-            , convexPolytopeRepresentatives+            , symmetricPolytopeOuterVertices             ) where  import Math.LinearMap.Category.Class import Math.LinearMap.Category.Instances import Math.LinearMap.Asserted import Math.VectorSpace.Docile+import Math.LinearMap.Category.TensorQuot  import Data.Tree (Tree(..), Forest) import Data.List (sortBy, foldl')@@ -449,7 +452,13 @@       = orthogonalComplementProj' . map (id &&& (m-+$>))  +-- | A space in which you can use '·' both for scaling with a real number,+--   and as dot-product for obtaining such a number.+type RealSpace v = ( LinearSpace v, Scalar v ~ ℝ+                   , TensorQuot v ℝ, (v⨸ℝ) ~ DualVector v+                   , TensorQuot v v, (v⨸v) ~ ℝ ) + data Eigenvector v = Eigenvector {       ev_Eigenvalue :: Scalar v -- ^ The estimated eigenvalue @λ@.     , ev_Eigenvector :: v       -- ^ Normalised vector @v@ that gets mapped to a multiple, namely:@@ -589,8 +598,12 @@  normSpanningSystem :: SimpleSpace v                => Seminorm v -> [DualVector v]-normSpanningSystem me@(Norm m)-     = catMaybes . map snd . orthonormaliseDuals 0+normSpanningSystem = map snd . normSpanningSystems++normSpanningSystems :: SimpleSpace v+               => Seminorm v -> [(v, DualVector v)]+normSpanningSystems me@(Norm m)+     = catMaybes . map (\(v,d)->(v,)<$>d) . orthonormaliseDuals 0          . map (id&&&(m-+$>)) $ normSpanningSystem' me  normSpanningSystem' :: (FiniteDimensional v, IEEE (Scalar v))@@ -723,49 +736,93 @@        candidates = [ (dv, dv<.>^v) | v <- vs                                    , let dv = nmv<$|v ] -convexPolytopeRepresentatives :: ∀ v . SimpleSpace v => [DualVector v] -> [v]-convexPolytopeRepresentatives dvs-         = [v^/η | ((v,η),dv) <- zip candidates dvs-                 , all (\(w,ψ) -> dv<.>^w <= ψ) candidates]+symmetricPolytopeOuterVertices :: ∀ v . SimpleSpace v => [DualVector v] -> [v]+symmetricPolytopeOuterVertices dvs+         = [ seekExtreme zeroV group | group <- candidates ]  where nmv :: Norm v        nmv = spanNorm dvs        vrv = dualNorm nmv-       candidates :: [(v, Scalar v)]-       candidates = [ (v, dv<.>^v) | dv <- dvs-                                   , let v = dv|&>vrv ]+       withSomeVect :: [(DualVector v, v)]+       withSomeVect = [ (dv, v) | dv <- dvs+                                , let v = dv|&>vrv ]+       (candidates, _) = multiSplit d (2*d) . concat . deinterlacions $ withSomeVect+       d = subbasisDimension (entireBasis :: SubBasis v)+       seekExtreme p₀ [] = p₀+       seekExtreme p₀ ((dv, v) : cs)+           = seekExtreme (p₀^+^vn) [(dw, w ^-^ v^*((dv<.>^w) / lv)) | (dw, w) <- cs]+        where vn = v ^* ((1 - dv<.>^p₀) / lv)+              lv = dv<.>^v +deinterlacions :: SimpleSpace a => [(DualVector a, a)] -> [[(DualVector a, a)]]+deinterlacions l = l : deinterlacions (e ++ map negateV o)+ where (e,o) = deinterlace l+       deinterlace (a:b:xs) = (a:)***(b:) $ deinterlace xs+       deinterlace xs = ([],xs)+       +-- | Simple wrapper of 'linearRegression'. linearRegressionW :: ∀ s x m y-    . ( LinearSpace x, FiniteDimensional y, SimpleSpace m+    . ( LinearSpace x, SimpleSpace y, SimpleSpace m       , Scalar x ~ s, Scalar y ~ s, Scalar m ~ s, RealFrac' s )          => Norm y -> (x -> (m +> y)) -> [(x,y)] -> m-linearRegressionW σy modelMap = fst . linearRegressionWVar modelMap . map (second (,σy))+linearRegressionW σy modelMap = linearFit_bestModel+                                   . linearRegression modelMap . map (second (,σy)) +data LinearRegressionResult x y m = LinearRegressionResult {+          linearFit_χν² :: Scalar m +           -- ^ How well the data uncertainties match the deviations from the model's+           --   synthetic data.+           -- @+           -- χν² = 1/ν · ∑ δy² / σy²+           -- @+           --   Where @ν@ is the number of degrees of freedom (data values minus model+           --   parameters), @δy = m x - yd@ is the deviation from given data to+           --   the data the model would predict (for each sample point), and @σy@ is+           --   the a-priori measurement uncertainty of the data points. +           -- +           --   Values @χν²>1@ indicate that the data could not be described satisfyingly;+           --   @χν²≪1@ suggests overfitting or that the data uncertainties have+           --   been postulated too high.+           -- +           -- <http://adsabs.harvard.edu/abs/1997ieas.book.....T>+           -- +           --   If the model is exactly determined or even underdetermined (i.e. @ν≤0@)+           --   then @χν²@ is undefined.+        , linearFit_bestModel :: m+           -- ^ The model that best corresponds to the data, in a least-squares+           --   sense WRT the supplied norm on the data points. In other words,+           --   this is the model that minimises @∑ δy² / σy²@.+        , linearFit_modelUncertainty :: Norm m+        }+ linearRegressionWVar :: ∀ s x m y     . ( LinearSpace x, FiniteDimensional y, SimpleSpace m       , Scalar x ~ s, Scalar y ~ s, Scalar m ~ s, RealFrac' s )          => (x -> (m +> y)) -> [(x, (y, Norm y))] -> (m, [DualVector m])-linearRegressionWVar = lrw (dualSpaceWitness, dualSpaceWitness)+linearRegressionWVar = case True of False -> undefined++linearRegression :: ∀ s x m y+    . ( LinearSpace x, SimpleSpace y, SimpleSpace m+      , Scalar x ~ s, Scalar y ~ s, Scalar m ~ s, RealFrac' s )+         => (x -> (m +> y)) -> [(x, (y, Norm y))] -> LinearRegressionResult x y m+linearRegression = lrw (dualSpaceWitness, dualSpaceWitness)  where lrw :: (DualSpaceWitness y, DualSpaceWitness m)-                -> (x -> (m +> y)) -> [(x, (y, Norm y))] -> (m, [DualVector m])+                -> (x -> (m +> y)) -> [(x, (y, Norm y))] -> LinearRegressionResult x y m        lrw (DualSpaceWitness, DualSpaceWitness) modelMap dataxy-         = ( leastSquareSol, deviations )+         = LinearRegressionResult (χ²/fromIntegral ν) leastSquareSol σm         where leastSquareSol = (lfun $ forward' . zipWith ((<$|) . snd . snd) dataxy                                           . forward)                                  \$ forward' [σy<$|y | (_,(y,σy)) <- dataxy]+              χ² = sum [normSq σy δy | (x, (yd, σy)) <- dataxy+                                     , let δy = yd ^-^ (modelMap x $ leastSquareSol) ]+              ν = length dataxy * subbasisDimension (entireBasis :: SubBasis y)+                  - subbasisDimension (entireBasis :: SubBasis m)               forward :: m -> [y]               forward m = [modelMap x $ m | (x,_)<-dataxy]               forward' :: [DualVector y] -> DualVector m-              forward' = sumV . zipWith ($) modelGens-              modelGens :: [DualVector y +> DualVector m]-              modelGens = ((adjoint$) . modelMap . fst)<$>dataxy-              deviations = [ m $ dy ^/ ψ-                           | (m,(dy,ψ)) <- zip modelGens ddys-                           , ψ > 0-                           ]-              ddys = [ (dy, ψ) | (x,(yd,σy)) <- dataxy-                               , let ym = modelMap x $ leastSquareSol-                                     δy = yd ^-^ ym-                                     dy = σy<$|δy-                                     ψ = dy<.>^δy-                     ]+              forward' = sumV . zipWith (($) . snd) modelGens+              modelGens :: [(m +> y, DualVector y +> DualVector m)]+              modelGens = ((id&&&arr adjoint) . modelMap . fst)<$>dataxy+              σm :: Norm m+              σm = mconcat [ Norm . arr $ m . (fmap ny $ m')+                           | ((_,(_,Norm ny)), (m',m)) <- zip dataxy modelGens ]                   

@@ -21,6 +21,7 @@ {-# LANGUAGE UnicodeSyntax              #-} {-# LANGUAGE TupleSections              #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE DeriveGeneric              #-} {-# LANGUAGE GADTs                      #-} {-# LANGUAGE DefaultSignatures          #-} @@ -43,6 +44,9 @@ import Math.LinearMap.Asserted import Math.VectorSpace.ZeroDimensional +import qualified GHC.Generics as Gnrx+import GHC.Generics (Generic, (:*:)((:*:)))+ data ClosedScalarWitness s where   ClosedScalarWitness :: (Scalar s ~ s, DualVector s ~ s) => ClosedScalarWitness s @@ -290,6 +294,28 @@ fromLinearMap = case dualSpaceWitness :: DualSpaceWitness v of                 DualSpaceWitness -> Coercion ++pseudoFmapTensorLHS :: (TensorProduct v w ~ TensorProduct v' w)+           => c v v' -> Coercion (Tensor s v w) (Tensor s v' w)+pseudoFmapTensorLHS _ = Coercion++pseudoPrecomposeLinmap :: (TensorProduct (DualVector v) w ~ TensorProduct (DualVector v') w)+           => c v' v -> Coercion (LinearMap s v w) (LinearMap s v' w)+pseudoPrecomposeLinmap _ = Coercion++envTensorLHSCoercion :: ( TensorProduct v w ~ TensorProduct v' w+                        , TensorProduct v w' ~ TensorProduct v' w' )+           => c v v' -> LinearFunction s' (Tensor s v w) (Tensor s v w')+                     -> LinearFunction s' (Tensor s v' w) (Tensor s v' w')+envTensorLHSCoercion i (LinearFunction f) = LinearFunction $ coerce f++envLinmapPrecomposeCoercion+       :: ( TensorProduct (DualVector v) w ~ TensorProduct (DualVector v') w+          , TensorProduct (DualVector v) w' ~ TensorProduct (DualVector v') w' )+           => c v' v -> LinearFunction s' (LinearMap s v w) (LinearMap s v w')+                     -> LinearFunction s' (LinearMap s v' w) (LinearMap s v' w')+envLinmapPrecomposeCoercion i (LinearFunction f) = LinearFunction $ coerce f+ -- | Infix synonym for 'LinearMap', without explicit mention of the scalar type. type v +> w = LinearMap (Scalar v) v w @@ -493,24 +519,6 @@        (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)               -> LinearFunction $ \f -> (sampleLinearFunction -+$> f . lCoFst)                                               ⊕ (sampleLinearFunction -+$> f . lCoSnd)---blockVectSpan = case ( dualSpaceWitness :: DualSpaceWitness u---                        , dualSpaceWitness :: DualSpaceWitness v ) of---     (DualSpaceWitness, DualSpaceWitness)---         -> (blockVectSpan >>> fmap lfstBlock) &&& (blockVectSpan >>> fmap lsndBlock)---                   >>> follow Tensor---contractTensorMap = flout LinearMap---             >>>  contractTensorMap . fmap (fst . flout Tensor) . arr fromTensor---               ***contractTensorMap . fmap (snd . flout Tensor) . arr fromTensor---             >>> addV---contractMapTensor = flout Tensor---             >>>  contractMapTensor . fmap (arr fromTensor . fst . flout LinearMap)---               ***contractMapTensor . fmap (arr fromTensor . snd . flout LinearMap)---             >>> addV---contractTensorWith = LinearFunction $ \(Tensor (fu, fv))---                        -> (contractTensorWith$fu) &&& (contractTensorWith$fv)---contractLinearMapAgainst = flout LinearMap >>> bilinearFunction---                   (\(mu,mv) f -> ((contractLinearMapAgainst$fromTensor$mu)$(fst.f))---                                + ((contractLinearMapAgainst$fromTensor$mv)$(snd.f)) )   applyDualVector = case ( scalarSpaceWitness :: ScalarSpaceWitness u                          , dualSpaceWitness :: DualSpaceWitness u                          , dualSpaceWitness :: DualSpaceWitness v ) of@@ -690,9 +698,6 @@                . coCurryLinearMap . fmap deferLinearMap $ id   coerceDoubleDual = case dualSpaceWitness :: DualSpaceWitness v of      DualSpaceWitness -> Coercion---blockVectSpan = arr deferLinearMap---                  . fmap (arr (fmap coUncurryLinearMap) . blockVectSpan)---                             . blockVectSpan'   applyLinear = case dualSpaceWitness :: DualSpaceWitness u of     DualSpaceWitness -> bilinearFunction $ \f g                   -> let tf = argAsTensor $ f@@ -714,12 +719,6 @@                   >>> \f -> LinearFunction $ \g                                -> (applyTensorLinMap-+$>f)                                    . arr (asTensor . hasteLinearMap) -+$> g---      -> coUncurryLinearMap $ fmap (fmap $ applyLinear $ f) $ (coCurryLinearMap$g)---contractTensorWith = arr hasteLinearMap >>> bilinearFunction (\l dw---                        -> fmap (flipBilin contractTensorWith $ dw) $ l )---contractLinearMapAgainst = arr coCurryLinearMap >>> bilinearFunction (\l f---                        -> (contractLinearMapAgainst . fmap transposeTensor $ l)---                              . uncurryLinearFn $f )  instance ∀ s u v . (TensorSpace u, TensorSpace v, Scalar u ~ s, Scalar v ~ s)                        => TensorSpace (Tensor s u v) where@@ -776,9 +775,6 @@   dualSpaceWitness = case ( dualSpaceWitness :: DualSpaceWitness u                           , dualSpaceWitness :: DualSpaceWitness v ) of     (DualSpaceWitness, DualSpaceWitness) -> DualSpaceWitness---blockVectSpan = arr lassocTensor . arr (fmap $ fmap uncurryLinearMap)---         . fmap (transposeTensor . arr deferLinearMap) . blockVectSpan---                 . arr deferLinearMap . fmap transposeTensor . blockVectSpan'   applyLinear = applyTensorLinMap   applyDualVector = applyTensorFunctional   applyTensorFunctional = atf scalarSpaceWitness dualSpaceWitness@@ -805,11 +801,6 @@     ScalarSpaceWitness -> contractTensorMap . fmap transposeTensor . contractMapTensor                  . fmap (arr (curryLinearMap . hasteLinearMap) . transposeTensor)                        . arr rassocTensor---contractTensorWith = arr rassocTensor >>> bilinearFunction (\l dw---                        -> fmap (flipBilin contractTensorWith $ dw) $ l )---contractLinearMapAgainst = arr curryLinearMap >>> bilinearFunction (\l f---                        -> (contractLinearMapAgainst $ l)---                              $ contractTensorMap . fmap (transposeTensor . f) )   @@ -968,10 +959,6 @@                $ LinearFunction $ \f -> sampleLinearFunction-+$>tensorProduct-+$>f   coerceDoubleDual = Coercion   sampleLinearFunction = LinearFunction . arr $ sym exposeLinearFn---contractLinearMapAgainst = arr coCurryLinearFn---                       >>> bilinearFunction (\v2uw w2uv---                         -> trace . fmap (contractTensorFn . fmap v2uw)---                             . sampleLinearFunction $ w2uv )   applyDualVector = case scalarSpaceWitness :: ScalarSpaceWitness u of        ScalarSpaceWitness -> bilinearFunction $                       \f g -> trace . sampleLinearFunction -+$> f . g@@ -1032,3 +1019,521 @@ lfun = arr . LinearFunction  +genericTensorspaceError :: a+genericTensorspaceError = error "GHC.Generics types can not be used as tensor spaces."++instance ∀ v s . TensorSpace v => TensorSpace (Gnrx.Rec0 v s) where+  type TensorProduct (Gnrx.Rec0 v s) w = TensorProduct v w+  wellDefinedVector = fmap Gnrx.K1 . wellDefinedVector . Gnrx.unK1+  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS Gnrx.K1)+                         . wellDefinedTensor . arr (pseudoFmapTensorLHS Gnrx.unK1)+  scalarSpaceWitness = genericTensorspaceError+  linearManifoldWitness = genericTensorspaceError+  zeroTensor = pseudoFmapTensorLHS Gnrx.K1 $ zeroTensor+  toFlatTensor = LinearFunction $ Gnrx.unK1 >>> getLinearFunction toFlatTensor+                   >>> arr (pseudoFmapTensorLHS Gnrx.K1)+  fromFlatTensor = LinearFunction $ Gnrx.K1 <<< getLinearFunction fromFlatTensor+                   <<< arr (pseudoFmapTensorLHS Gnrx.unK1)+  addTensors (Tensor s) (Tensor t)+       = pseudoFmapTensorLHS Gnrx.K1 $ addTensors (Tensor s) (Tensor t)+  scaleTensor = LinearFunction $ \μ -> envTensorLHSCoercion Gnrx.K1+                                         $ scaleTensor-+$>μ+  negateTensor = envTensorLHSCoercion Gnrx.K1 negateTensor+  tensorProduct = bilinearFunction $ \(Gnrx.K1 v) w+                      -> pseudoFmapTensorLHS Gnrx.K1+                           $ (tensorProduct-+$>v)-+$>w+  transposeTensor = tT+   where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar v)+                => (Gnrx.Rec0 v s ⊗ w) -+> (w ⊗ Gnrx.Rec0 v s)+         tT = LinearFunction+           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])+                                    (Coercion :: Coercion v (Gnrx.Rec0 v s)) . Coercion)+              . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS Gnrx.unK1)+  fmapTensor = LinearFunction $+         \f -> envTensorLHSCoercion Gnrx.K1 (fmapTensor-+$>f)+  fzipTensorWith = bilinearFunction $+         \f (wt, xt) -> pseudoFmapTensorLHS Gnrx.K1+                        $ (fzipTensorWith-+$>f)+                         -+$>( pseudoFmapTensorLHS Gnrx.unK1 $ wt+                             , pseudoFmapTensorLHS Gnrx.unK1 $ xt )+  coerceFmapTensorProduct = cmtp+   where cmtp :: ∀ p a b . Hask.Functor p+             => p (Gnrx.Rec0 v s) -> Coercion a b+               -> Coercion (TensorProduct (Gnrx.Rec0 v s) a)+                           (TensorProduct (Gnrx.Rec0 v s) b)+         cmtp p crc = case coerceFmapTensorProduct ([]::[v]) crc of+                  Coercion -> Coercion++instance ∀ i c f p . TensorSpace (f p) => TensorSpace (Gnrx.M1 i c f p) where+  type TensorProduct (Gnrx.M1 i c f p) w = TensorProduct (f p) w+  wellDefinedVector = fmap Gnrx.M1 . wellDefinedVector . Gnrx.unM1+  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS Gnrx.M1)+                         . wellDefinedTensor . arr (pseudoFmapTensorLHS Gnrx.unM1)+  scalarSpaceWitness = genericTensorspaceError+  linearManifoldWitness = genericTensorspaceError+  zeroTensor = pseudoFmapTensorLHS Gnrx.M1 $ zeroTensor+  toFlatTensor = LinearFunction $ Gnrx.unM1 >>> getLinearFunction toFlatTensor+                   >>> arr (pseudoFmapTensorLHS Gnrx.M1)+  fromFlatTensor = LinearFunction $ Gnrx.M1 <<< getLinearFunction fromFlatTensor+                   <<< arr (pseudoFmapTensorLHS Gnrx.unM1)+  addTensors (Tensor s) (Tensor t)+       = pseudoFmapTensorLHS Gnrx.M1 $ addTensors (Tensor s) (Tensor t)+  scaleTensor = LinearFunction $ \μ -> envTensorLHSCoercion Gnrx.M1+                                         $ scaleTensor-+$>μ+  negateTensor = envTensorLHSCoercion Gnrx.M1 negateTensor+  tensorProduct = bilinearFunction $ \(Gnrx.M1 v) w+                      -> pseudoFmapTensorLHS Gnrx.M1+                           $ (tensorProduct-+$>v)-+$>w+  transposeTensor = tT+   where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar (f p))+                => (Gnrx.M1 i c f p ⊗ w) -+> (w ⊗ Gnrx.M1 i c f p)+         tT = LinearFunction+           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])+                                (Coercion :: Coercion (f p) (Gnrx.M1 i c f p)) . Coercion)+              . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS Gnrx.unM1)+  fmapTensor = LinearFunction $+         \f -> envTensorLHSCoercion Gnrx.M1 (fmapTensor-+$>f)+  fzipTensorWith = bilinearFunction $+         \f (wt, xt) -> pseudoFmapTensorLHS Gnrx.M1+                        $ (fzipTensorWith-+$>f)+                         -+$>( pseudoFmapTensorLHS Gnrx.unM1 $ wt+                             , pseudoFmapTensorLHS Gnrx.unM1 $ xt )+  coerceFmapTensorProduct = cmtp+   where cmtp :: ∀ ぴ a b . Hask.Functor ぴ+             => ぴ (Gnrx.M1 i c f p) -> Coercion a b+               -> Coercion (TensorProduct (Gnrx.M1 i c f p) a)+                           (TensorProduct (Gnrx.M1 i c f p) b)+         cmtp p crc = case coerceFmapTensorProduct ([]::[f p]) crc of+                  Coercion -> Coercion++instance ∀ f g p . ( TensorSpace (f p), TensorSpace (g p), Scalar (f p) ~ Scalar (g p) )+                       => TensorSpace ((f:*:g) p) where+  type TensorProduct ((f:*:g) p) w = (f p⊗w, g p⊗w)+  scalarSpaceWitness = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                            , scalarSpaceWitness :: ScalarSpaceWitness (g p) ) of+       (ScalarSpaceWitness, ScalarSpaceWitness) -> ScalarSpaceWitness+  linearManifoldWitness = genericTensorspaceError+  zeroTensor = Tensor (zeroTensor, zeroTensor)+  scaleTensor = bilinearFunction $ \μ (Tensor (v,w)) ->+                 Tensor ( (scaleTensor-+$>μ)-+$>v, (scaleTensor-+$>μ)-+$>w )+  negateTensor = LinearFunction $ \(Tensor (v,w))+          -> Tensor (negateTensor-+$>v, negateTensor-+$>w)+  addTensors (Tensor (fu, fv)) (Tensor (fu', fv'))+           = Tensor (fu ^+^ fu', fv ^+^ fv')+  subtractTensors (Tensor (fu, fv)) (Tensor (fu', fv'))+          = Tensor (fu ^-^ fu', fv ^-^ fv')+  toFlatTensor = LinearFunction+      $ \(u:*:v) -> Tensor (toFlatTensor-+$>u, toFlatTensor-+$>v)+  fromFlatTensor = LinearFunction+      $ \(Tensor (u,v)) -> (fromFlatTensor-+$>u):*:(fromFlatTensor-+$>v)+  tensorProduct = bilinearFunction $ \(u:*:v) w ->+      Tensor ((tensorProduct-+$>u)-+$>w, (tensorProduct-+$>v)-+$>w)+  transposeTensor = LinearFunction $ \(Tensor (uw,vw))+        -> (fzipTensorWith-+$>LinearFunction (\(u,v)->u:*:v))+             -+$>(transposeTensor-+$>uw,transposeTensor-+$>vw)+  fmapTensor = bilinearFunction $+     \f (Tensor (uw,vw)) -> Tensor ((fmapTensor-+$>f)-+$>uw, (fmapTensor-+$>f)-+$>vw)+  fzipTensorWith = bilinearFunction+               $ \f (Tensor (uw, vw), Tensor (ux, vx))+                      -> Tensor ( (fzipTensorWith-+$>f)-+$>(uw,ux)+                                , (fzipTensorWith-+$>f)-+$>(vw,vx) )+  coerceFmapTensorProduct p cab = case+             ( coerceFmapTensorProduct ((\(u:*:_)->u)<$>p) cab+             , coerceFmapTensorProduct ((\(_:*:v)->v)<$>p) cab ) of+          (Coercion, Coercion) -> Coercion+  wellDefinedVector (u:*:v) = liftA2 (:*:) (wellDefinedVector u) (wellDefinedVector v)+  wellDefinedTensor (Tensor (u,v))+         = liftA2 ((Tensor.) . (,)) (wellDefinedTensor u) (wellDefinedTensor v)+++instance ∀ m . ( Semimanifold m, TensorSpace (Needle (VRep m))+                               , Scalar (Needle m) ~ Scalar (Needle (VRep m)) )+                  => TensorSpace (GenericNeedle m) where+  type TensorProduct (GenericNeedle m) w = TensorProduct (Needle (VRep m)) w+  wellDefinedVector = fmap GenericNeedle . wellDefinedVector . getGenericNeedle+  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS GenericNeedle)+                         . wellDefinedTensor . arr (pseudoFmapTensorLHS getGenericNeedle)+  scalarSpaceWitness = case scalarSpaceWitness+                               :: ScalarSpaceWitness (Needle (VRep m)) of+          ScalarSpaceWitness -> ScalarSpaceWitness+  linearManifoldWitness = case linearManifoldWitness+                               :: LinearManifoldWitness (Needle (VRep m)) of+          LinearManifoldWitness BoundarylessWitness+              -> LinearManifoldWitness BoundarylessWitness+  zeroTensor = pseudoFmapTensorLHS GenericNeedle $ zeroTensor+  toFlatTensor = LinearFunction $ arr (pseudoFmapTensorLHS GenericNeedle)+                             . getLinearFunction toFlatTensor+                             . getGenericNeedle+  fromFlatTensor = LinearFunction $ arr (pseudoFmapTensorLHS getGenericNeedle)+                             >>> getLinearFunction fromFlatTensor+                             >>> GenericNeedle+  addTensors (Tensor s) (Tensor t)+       = pseudoFmapTensorLHS GenericNeedle $ addTensors (Tensor s) (Tensor t)+  scaleTensor = LinearFunction $ \μ -> envTensorLHSCoercion GenericNeedle+                                         $ scaleTensor-+$>μ+  negateTensor = envTensorLHSCoercion GenericNeedle negateTensor+  tensorProduct = bilinearFunction $ \(GenericNeedle v) w+                      -> pseudoFmapTensorLHS GenericNeedle+                           $ (tensorProduct-+$>v)-+$>w+  transposeTensor = tT+   where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar (Needle m))+                => (GenericNeedle m ⊗ w) -+> (w ⊗ GenericNeedle m)+         tT = LinearFunction+           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])+                              (Coercion :: Coercion (Needle (VRep m))+                                                    (GenericNeedle m)) . Coercion)+              . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS getGenericNeedle)+  fmapTensor = LinearFunction $+         \f -> envTensorLHSCoercion GenericNeedle (fmapTensor-+$>f)+  fzipTensorWith = bilinearFunction $+         \f (wt, xt) -> pseudoFmapTensorLHS GenericNeedle+                        $ (fzipTensorWith-+$>f)+                         -+$>( pseudoFmapTensorLHS getGenericNeedle $ wt+                             , pseudoFmapTensorLHS getGenericNeedle $ xt )+  coerceFmapTensorProduct = cmtp+   where cmtp :: ∀ p a b . Hask.Functor p+             => p (GenericNeedle m) -> Coercion a b+               -> Coercion (TensorProduct (GenericNeedle m) a)+                           (TensorProduct (GenericNeedle m) b)+         cmtp p crc = case coerceFmapTensorProduct ([]::[Needle (VRep m)]) crc of+                  Coercion -> Coercion++instance (LinearSpace v, Num (Scalar v)) => LinearSpace (Gnrx.Rec0 v s) where+  type DualVector (Gnrx.Rec0 v s) = DualVector v+  dualSpaceWitness = genericTensorspaceError+  linearId = pseudoPrecomposeLinmap Gnrx.unK1+                . fmap (follow Gnrx.K1) $ linearId+  applyDualVector = bilinearFunction $ \dv (Gnrx.K1 v) -> (applyDualVector-+$>dv)-+$>v+  applyLinear = bilinearFunction $ \(LinearMap f) (Gnrx.K1 v)+                      -> (applyLinear-+$>LinearMap f)-+$>v+  tensorId = pseudoPrecomposeLinmap (pseudoFmapTensorLHS Gnrx.unK1)+                . fmap (pseudoFmapTensorLHS Gnrx.K1) $ tensorId+  applyTensorFunctional = bilinearFunction $ \(LinearMap f) t ->+              (applyTensorFunctional-+$>LinearMap f)-+$>pseudoFmapTensorLHS Gnrx.unK1 $ t+  applyTensorLinMap = bilinearFunction $ \(LinearMap f) t+                -> (applyTensorLinMap-+$>LinearMap f)-+$>pseudoFmapTensorLHS Gnrx.unK1 $ t++instance (LinearSpace (f p), Num (Scalar (f p))) => LinearSpace (Gnrx.M1 i c f p) where+  type DualVector (Gnrx.M1 i c f p) = DualVector (f p)+  dualSpaceWitness = genericTensorspaceError+  linearId = pseudoPrecomposeLinmap Gnrx.unM1+                . fmap (follow Gnrx.M1) $ linearId+  applyDualVector = bilinearFunction $ \dv (Gnrx.M1 v) -> (applyDualVector-+$>dv)-+$>v+  applyLinear = bilinearFunction $ \(LinearMap f) (Gnrx.M1 v)+                      -> (applyLinear-+$>LinearMap f)-+$>v+  tensorId = pseudoPrecomposeLinmap (pseudoFmapTensorLHS Gnrx.unM1)+                . fmap (pseudoFmapTensorLHS Gnrx.M1) $ tensorId+  applyTensorFunctional = bilinearFunction $ \(LinearMap f) t ->+              (applyTensorFunctional-+$>LinearMap f)-+$>pseudoFmapTensorLHS Gnrx.unM1 $ t+  applyTensorLinMap = bilinearFunction $ \(LinearMap f) t+                -> (applyTensorLinMap-+$>LinearMap f)-+$>pseudoFmapTensorLHS Gnrx.unM1 $ t++data GenericTupleDual f g p+    = GenericTupleDual !(DualVector (f p)) !(DualVector (g p)) deriving (Generic)+instance (AdditiveGroup (DualVector (f p)), AdditiveGroup (DualVector (g p)))+    => AdditiveGroup (GenericTupleDual f g p)+instance ( VectorSpace (DualVector (f p)), VectorSpace (DualVector (g p))+         , Scalar (DualVector (f p)) ~ Scalar (DualVector (g p)) )+    => VectorSpace (GenericTupleDual f g p)+instance ( InnerSpace (DualVector (f p)), InnerSpace (DualVector (g p))+         , Scalar (DualVector (f p)) ~ Scalar (DualVector (g p))+         , Num (Scalar (DualVector (f p))) )+    => InnerSpace (GenericTupleDual f g p)+instance (AdditiveGroup (DualVector (f p)), AdditiveGroup (DualVector (g p)))+    => AffineSpace (GenericTupleDual f g p) where+  type Diff (GenericTupleDual f g p) = GenericTupleDual f g p+  (.+^) = (^+^)+  (.-.) = (^-^)+instance (AdditiveGroup (DualVector (f p)), AdditiveGroup (DualVector (g p)))+    => Semimanifold (GenericTupleDual f g p) where+  type Needle (GenericTupleDual f g p) = GenericTupleDual f g p+  (.+~^) = (^+^)+  fromInterior = id+  toInterior = pure+  translateP = Tagged (^+^)+instance (AdditiveGroup (DualVector (f p)), AdditiveGroup (DualVector (g p)))+    => PseudoAffine (GenericTupleDual f g p) where+  p.-~.q = Just $ p.-.q+  (.-~!) = (.-.)++instance ( LinearSpace (f p), LinearSpace (g p)+         , VectorSpace (DualVector (f p)), VectorSpace (DualVector (g p))+         , Scalar (f p) ~ Scalar (DualVector (f p))+         , Scalar (g p) ~ Scalar (DualVector (g p))+         , Scalar (DualVector (f p)) ~ Scalar (DualVector (g p)) )+    => TensorSpace (GenericTupleDual f g p) where+  type TensorProduct (GenericTupleDual f g p) w = (f p+>w, g p+>w)+  wellDefinedVector = case ( dualSpaceWitness :: DualSpaceWitness (f p)+                           , dualSpaceWitness :: DualSpaceWitness (g p) ) of+      (DualSpaceWitness, DualSpaceWitness)+       -> \(GenericTupleDual fv gv)+           -> liftA2 GenericTupleDual (wellDefinedVector fv) (wellDefinedVector gv)+  wellDefinedTensor = case ( dualSpaceWitness :: DualSpaceWitness (f p)+                           , dualSpaceWitness :: DualSpaceWitness (g p) ) of+      (DualSpaceWitness, DualSpaceWitness)+       -> \(Tensor (ft, gt))+        -> Tensor <$> liftA2 (,) (fmap fromTensor $ wellDefinedTensor (fromLinearMap $ ft))+                                 (fmap fromTensor $ wellDefinedTensor (fromLinearMap $ gt))+  scalarSpaceWitness = case scalarSpaceWitness :: ScalarSpaceWitness (f p) of+        ScalarSpaceWitness -> ScalarSpaceWitness+  linearManifoldWitness = LinearManifoldWitness BoundarylessWitness+  zeroTensor = case ( linearManifoldWitness :: LinearManifoldWitness (f p)+                    , dualSpaceWitness :: DualSpaceWitness (f p)+                    , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       ( LinearManifoldWitness BoundarylessWitness+        ,DualSpaceWitness, DualSpaceWitness )+           -> Tensor (fromTensor $ zeroTensor, fromTensor $ zeroTensor)+  toFlatTensor = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                      , dualSpaceWitness :: DualSpaceWitness (f p)+                      , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+          -> LinearFunction $ \(GenericTupleDual tf tg)+            -> Tensor ( toLinearForm $ tf, toLinearForm $ tg )+  fromFlatTensor = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                        , dualSpaceWitness :: DualSpaceWitness (f p)+                        , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+          -> LinearFunction $ \(Tensor (tf,tg))+            -> GenericTupleDual (fromLinearForm $ tf) (fromLinearForm $ tg)+  addTensors (Tensor (sf,sg)) (Tensor (tf,tg)) = Tensor (sf^+^tf, sg^+^tg)+  negateTensor = LinearFunction $ \(Tensor (tf,tg))+                   -> Tensor (negateV tf, negateV tg)+  scaleTensor = bilinearFunction $ \μ (Tensor (tf,tg)) -> Tensor (μ*^tf, μ*^tg)+  tensorProduct = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                       , dualSpaceWitness :: DualSpaceWitness (f p)+                       , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+          -> bilinearFunction $ \(GenericTupleDual fw gw) x+                   -> Tensor (fromTensor $ fw⊗x, fromTensor $ gw⊗x)+  transposeTensor = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                         , dualSpaceWitness :: DualSpaceWitness (f p)+                         , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+          -> LinearFunction $ \(Tensor (fw, gw))+                     -> (fzipTensorWith-+$>LinearFunction`id`uncurry GenericTupleDual)+                       -+$> ( transposeTensor-+$>asTensor $ fw+                            , transposeTensor-+$>asTensor $ gw )+  fmapTensor = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                    , dualSpaceWitness :: DualSpaceWitness (f p)+                    , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+          -> bilinearFunction $ \f (Tensor (fw, gw))+                 -> Tensor ( fromTensor $ (fmapTensor-+$>f) -+$> asTensor $ fw+                           , fromTensor $ (fmapTensor-+$>f) -+$> asTensor $ gw )+  fzipTensorWith = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                        , dualSpaceWitness :: DualSpaceWitness (f p)+                        , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+          -> bilinearFunction $ \f (Tensor (fw, gw), Tensor (fx, gx))+                 -> Tensor ( fromTensor $ (fzipTensorWith-+$>f) -+$> ( asTensor $ fw+                                                                     , asTensor $ fx )+                           , fromTensor $ (fzipTensorWith-+$>f) -+$> ( asTensor $ gw+                                                                     , asTensor $ gx ) )+  coerceFmapTensorProduct p cab = case ( dualSpaceWitness :: DualSpaceWitness (f p)+                                       , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (DualSpaceWitness, DualSpaceWitness) -> case+             ( coerceFmapTensorProduct ((\(GenericTupleDual u _)->u)<$>p) cab+             , coerceFmapTensorProduct ((\(GenericTupleDual _ v)->v)<$>p) cab ) of+          (Coercion, Coercion) -> Coercion+  +++instance ∀ f g p . ( LinearSpace (f p), LinearSpace (g p), Scalar (f p) ~ Scalar (g p) )+                       => LinearSpace ((f:*:g) p) where+  type DualVector ((f:*:g) p) = GenericTupleDual f g p+  +  dualSpaceWitness = genericTensorspaceError+  linearId = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                  , dualSpaceWitness :: DualSpaceWitness (f p)+                  , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+             -> LinearMap ( arr $ LinearFunction (\vf->(vf:*:zeroV))+                          , arr $ LinearFunction (\vg->(zeroV:*:vg)) )+  tensorId = tI scalarSpaceWitness dualSpaceWitness dualSpaceWitness dualSpaceWitness+   where tI :: ∀ w . (LinearSpace w, Scalar w ~ Scalar (f p))+                 => ScalarSpaceWitness (f p) -> DualSpaceWitness (f p)+                     -> DualSpaceWitness (g p) -> DualSpaceWitness w+                       -> (((f:*:g) p)⊗w)+>(((f:*:g) p)⊗w)+         tI ScalarSpaceWitness DualSpaceWitness DualSpaceWitness DualSpaceWitness +              = LinearMap+            ( arr $ LinearFunction (\vf -> asTensor+             $ arr (LinearFunction $ \w -> Tensor (vf⊗w, zeroV)))+            , arr $ LinearFunction (\vg -> asTensor+             $ arr (LinearFunction $ \w -> Tensor (zeroV, vg⊗w))) )+  sampleLinearFunction = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                              , dualSpaceWitness :: DualSpaceWitness (f p)+                              , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+              -> LinearFunction $ \f -> LinearMap+                   ( sampleLinearFunction -+$> LinearFunction`id`+                       \vf -> f -+$> (vf:*:zeroV)+                   , sampleLinearFunction -+$> LinearFunction`id`+                       \vg -> f -+$> (zeroV:*:vg) )+  applyDualVector = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                         , dualSpaceWitness :: DualSpaceWitness (f p)+                         , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+              -> bilinearFunction $ \(GenericTupleDual du dv) (u:*:v)+                      -> ((applyDualVector-+$>du)-+$>u) ^+^ ((applyDualVector-+$>dv)-+$>v)+  applyLinear = case ( scalarSpaceWitness :: ScalarSpaceWitness (f p)+                     , dualSpaceWitness :: DualSpaceWitness (f p)+                     , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (ScalarSpaceWitness, DualSpaceWitness, DualSpaceWitness)+              -> bilinearFunction $ \(LinearMap (fu, fv)) (u:*:v)+                      -> ((applyLinear-+$>fu)-+$>u) ^+^ ((applyLinear-+$>fv)-+$>v)+  composeLinear = case ( dualSpaceWitness :: DualSpaceWitness (f p)+                       , dualSpaceWitness :: DualSpaceWitness (g p) ) of+       (DualSpaceWitness, DualSpaceWitness)+              -> bilinearFunction $ \f (LinearMap (fu, fv))+                    -> LinearMap ( (composeLinear-+$>f)-+$>fu+                                 , (composeLinear-+$>f)-+$>fv )+  applyTensorFunctional = case ( dualSpaceWitness :: DualSpaceWitness (f p)+                               , dualSpaceWitness :: DualSpaceWitness (g p) ) of+     (DualSpaceWitness, DualSpaceWitness) -> bilinearFunction $+                  \(LinearMap (fu,fv)) (Tensor (tu,tv))+          -> ((applyTensorFunctional-+$>fu)-+$>tu) + ((applyTensorFunctional-+$>fu)-+$>tu)+  applyTensorLinMap = case ( dualSpaceWitness :: DualSpaceWitness (f p)+                           , dualSpaceWitness :: DualSpaceWitness (g p) ) of+     (DualSpaceWitness, DualSpaceWitness) -> bilinearFunction`id`+             \(LinearMap (fu,fv)) (Tensor (tu,tv))+          -> ((applyTensorLinMap -+$> uncurryLinearMap . fmap fromTensor $ fu)-+$>tu)+           ^+^ ((applyTensorLinMap -+$> uncurryLinearMap . fmap fromTensor $ fv)-+$>tv)+++newtype GenericNeedle' m+    = GenericNeedle' { getGenericNeedle' :: DualVector (Needle (VRep m)) }+        deriving (Generic)+instance AdditiveGroup (DualVector (Needle (VRep m)))+      => AdditiveGroup (GenericNeedle' m)+instance ( VectorSpace (DualVector (Needle (VRep m)))+         , Scalar (Needle m) ~ Scalar (DualVector (Needle (VRep m))) )+      => VectorSpace (GenericNeedle' m) where+  type Scalar (GenericNeedle' m) = Scalar (Needle m)+instance AdditiveGroup (DualVector (Needle (VRep m)))+      => AffineSpace (GenericNeedle' m) where+  type Diff (GenericNeedle' m) = GenericNeedle' m+  (.-.) = (^-^)+  (.+^) = (^+^)+instance AdditiveGroup (DualVector (Needle (VRep m)))+    => Semimanifold (GenericNeedle' m) where+  type Interior (GenericNeedle' m) = GenericNeedle' m+  type Needle (GenericNeedle' m) = GenericNeedle' m+  toInterior = pure+  fromInterior = id+  translateP = Tagged (^+^)+  (.+~^) = (^+^)+instance AdditiveGroup (DualVector (Needle (VRep m)))+    => PseudoAffine (GenericNeedle' m) where+  p.-~.q = pure (p^-^q)+  (.-~!) = (^-^)+instance ∀ m . ( Semimanifold m, TensorSpace (DualVector (Needle (VRep m)))+               , Scalar (Needle m) ~ Scalar (DualVector (Needle (VRep m))) )+                  => TensorSpace (GenericNeedle' m) where+  type TensorProduct (GenericNeedle' m) w+         = TensorProduct (DualVector (Needle (VRep m))) w+  wellDefinedVector = fmap GenericNeedle' . wellDefinedVector . getGenericNeedle'+  wellDefinedTensor = arr (fmap $ pseudoFmapTensorLHS GenericNeedle')+                         . wellDefinedTensor . arr (pseudoFmapTensorLHS getGenericNeedle')+  scalarSpaceWitness = case scalarSpaceWitness+                    :: ScalarSpaceWitness (DualVector (Needle (VRep m))) of+          ScalarSpaceWitness -> ScalarSpaceWitness+  linearManifoldWitness = case linearManifoldWitness+                    :: LinearManifoldWitness (DualVector (Needle (VRep m))) of+          LinearManifoldWitness BoundarylessWitness+              -> LinearManifoldWitness BoundarylessWitness+  zeroTensor = pseudoFmapTensorLHS GenericNeedle' $ zeroTensor+  toFlatTensor = LinearFunction $ arr (pseudoFmapTensorLHS GenericNeedle')+                             . getLinearFunction toFlatTensor+                             . getGenericNeedle'+  fromFlatTensor = LinearFunction $ arr (pseudoFmapTensorLHS getGenericNeedle')+                             >>> getLinearFunction fromFlatTensor+                             >>> GenericNeedle'+  addTensors (Tensor s) (Tensor t)+       = pseudoFmapTensorLHS GenericNeedle' $ addTensors (Tensor s) (Tensor t)+  scaleTensor = LinearFunction $ \μ -> envTensorLHSCoercion GenericNeedle'+                                         $ scaleTensor-+$>μ+  negateTensor = envTensorLHSCoercion GenericNeedle' negateTensor+  tensorProduct = bilinearFunction $ \(GenericNeedle' v) w+                      -> pseudoFmapTensorLHS GenericNeedle'+                           $ (tensorProduct-+$>v)-+$>w+  transposeTensor = tT+   where tT :: ∀ w . (TensorSpace w, Scalar w ~ Scalar (Needle m))+                => (GenericNeedle' m ⊗ w) -+> (w ⊗ GenericNeedle' m)+         tT = LinearFunction+           $ arr (Coercion . coerceFmapTensorProduct ([]::[w])+                              (Coercion :: Coercion (DualVector (Needle (VRep m)))+                                                    (GenericNeedle' m)) . Coercion)+              . getLinearFunction transposeTensor . arr (pseudoFmapTensorLHS getGenericNeedle')+  fmapTensor = LinearFunction $+         \f -> envTensorLHSCoercion GenericNeedle' (fmapTensor-+$>f)+  fzipTensorWith = bilinearFunction $+         \f (wt, xt) -> pseudoFmapTensorLHS GenericNeedle'+                        $ (fzipTensorWith-+$>f)+                         -+$>( pseudoFmapTensorLHS getGenericNeedle' $ wt+                             , pseudoFmapTensorLHS getGenericNeedle' $ xt )+  coerceFmapTensorProduct = cmtp+   where cmtp :: ∀ p a b . Hask.Functor p+             => p (GenericNeedle' m) -> Coercion a b+               -> Coercion (TensorProduct (GenericNeedle' m) a)+                           (TensorProduct (GenericNeedle' m) b)+         cmtp p crc = case coerceFmapTensorProduct+                              ([]::[DualVector (Needle (VRep m))]) crc of+                  Coercion -> Coercion+++instance ∀ s m . ( Num' s+                 , Semimanifold m, LinearSpace (Needle (VRep m))+                 , Scalar (Needle m) ~ s+                 , Scalar (Needle (VRep m)) ~ s )+                  => LinearSpace (GenericNeedle m) where+  type DualVector (GenericNeedle m) = GenericNeedle' m+  linearId = fmap (follow GenericNeedle) . pseudoPrecomposeLinmap getGenericNeedle+               $ linearId+  dualSpaceWitness = case ( closedScalarWitness :: ClosedScalarWitness s+                          , dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) ) of+              (ClosedScalarWitness, DualSpaceWitness) -> DualSpaceWitness+  applyDualVector = bilinearFunction $ \(GenericNeedle' dv) (GenericNeedle v)+                        -> (applyDualVector-+$>dv)-+$>v+  applyLinear = bilinearFunction $ \(LinearMap f) (GenericNeedle v)+                      -> (applyLinear-+$>LinearMap f)-+$>v+  tensorId = pseudoPrecomposeLinmap (pseudoFmapTensorLHS getGenericNeedle)+                . fmap (pseudoFmapTensorLHS GenericNeedle) $ tensorId+  applyTensorFunctional = bilinearFunction $ \(LinearMap f) t ->+              (applyTensorFunctional-+$>LinearMap f)+                 -+$>pseudoFmapTensorLHS getGenericNeedle $ t+  applyTensorLinMap = bilinearFunction $ \(LinearMap f) t+                -> (applyTensorLinMap-+$>LinearMap f)+                    -+$>pseudoFmapTensorLHS getGenericNeedle $ t++instance ∀ s m . ( Num' s+                 , Semimanifold m+                 , LinearSpace (Needle (VRep m))+                 , TensorSpace (DualVector (Needle (VRep m)))+                 , Scalar (Needle m) ~ s+                 , Scalar (Needle (VRep m)) ~ s+                 , Scalar (DualVector (Needle (VRep m))) ~ s )+                  => LinearSpace (GenericNeedle' m) where+  type DualVector (GenericNeedle' m) = GenericNeedle m+  linearId = case dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) of+       DualSpaceWitness -> fmap (follow GenericNeedle')+                         . pseudoPrecomposeLinmap getGenericNeedle' $ linearId+  dualSpaceWitness = case ( closedScalarWitness :: ClosedScalarWitness s+                          , dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) ) of+              (ClosedScalarWitness, DualSpaceWitness) -> DualSpaceWitness+  applyDualVector = case dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) of+       DualSpaceWitness -> bilinearFunction $ \(GenericNeedle dv) (GenericNeedle' v)+                        -> (applyDualVector-+$>dv)-+$>v+  applyLinear = case dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) of+       DualSpaceWitness -> bilinearFunction $ \(LinearMap f) (GenericNeedle' v)+                      -> (applyLinear-+$>LinearMap f)-+$>v+  tensorId = case dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) of+       DualSpaceWitness -> pseudoPrecomposeLinmap (pseudoFmapTensorLHS getGenericNeedle')+                . fmap (pseudoFmapTensorLHS GenericNeedle') $ tensorId+  applyTensorFunctional = case dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) of+       DualSpaceWitness -> bilinearFunction $ \(LinearMap f) t ->+              (applyTensorFunctional-+$>LinearMap f)+                 -+$>pseudoFmapTensorLHS getGenericNeedle' $ t+  applyTensorLinMap = case dualSpaceWitness :: DualSpaceWitness (Needle (VRep m)) of+       DualSpaceWitness -> bilinearFunction $ \(LinearMap f) t+                -> (applyTensorLinMap-+$>LinearMap f)+                    -+$>pseudoFmapTensorLHS getGenericNeedle' $ t

@@ -0,0 +1,81 @@+-- |+-- Module      : Math.LinearMap.Category.TensorQuot+-- Copyright   : (c) Justus Sagemüller 2016+-- License     : GPL v3+-- +-- Maintainer  : (@) sagemueller $ geo.uni-koeln.de+-- Stability   : experimental+-- Portability : portable+-- +++{-# LANGUAGE CPP                   #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE UnicodeSyntax         #-}+{-# LANGUAGE TupleSections         #-}+{-# LANGUAGE ConstraintKinds       #-}++module Math.LinearMap.Category.TensorQuot where++import Math.LinearMap.Category.Class+import Math.LinearMap.Category.Instances+import Math.LinearMap.Asserted++import Data.VectorSpace+import Data.VectorSpace.Free++infixl 7 ·++class (TensorSpace v, VectorSpace w) => TensorQuot v w where+  type v ⨸ w :: *+  -- | Generalised multiplication operation. This subsumes '<.>^' and '*^'.+  --   For scalars therefore also '*', and for 'InnerSpace', '<.>'.+  (·) :: v ⨸ w -> v -> w++instance TensorQuot Double Double where+  type Double ⨸ Double = Double+  (·) = (*)++instance ( TensorQuot x v, TensorQuot y w+         , Scalar x ~ Scalar y, Scalar v ~ Scalar w+         , (x⨸v) ~ (y⨸w) )+      => TensorQuot (x,y) (v,w) where+  type (x,y) ⨸ (v,w) = x⨸v+  μ·(x,y) = (μ·x, μ·y)+instance ( TensorQuot x Double, TensorQuot y Double+         , Scalar x ~ Double, Scalar y ~ Double )+      => TensorQuot (x,y) Double where+  type (x,y) ⨸ Double = (x ⨸ Double, y ⨸ Double)+  (v,w)·(x,y) = v·x + w·y++#define FreeTensorQuot(V)                                \+instance (Num' s, Eq s) => TensorQuot (V s) (V s) where { \+  type V s ⨸ V s = s;                                      \+  (·) = (*^) };                                             \+instance TensorQuot (V Double) Double where {                \+  type V Double ⨸ Double = V Double;                          \+  (·) = (<.>) }++FreeTensorQuot(V1)+FreeTensorQuot(V2)+FreeTensorQuot(V3)+FreeTensorQuot(V4)++instance ∀ s x y v w .+    ( TensorSpace v, TensorSpace w, v ~ x, LinearSpace y+    , TensorQuot x v, TensorQuot y w, (x⨸v) ~ s, (y⨸w) ~ s+    , Scalar x ~ s, Scalar y ~ s, Scalar v ~ s, Scalar w ~ s )+      => TensorQuot (Tensor s x y) (Tensor s v w) where+  type Tensor s x y ⨸ Tensor s v w = s+  μ·t = (fmapTensor-+$>lfun(μ·))-+$>t+instance ( LinearSpace x, LinearSpace y+         , s ~ Double, Scalar x ~ s, Scalar y ~ s )+      => TensorQuot (Tensor s x y) Double where+  type (Tensor s x y) ⨸ Double = DualVector (Tensor s x y)+  f·t = (applyTensorFunctional-+$>f)-+$>t

@@ -233,6 +233,10 @@        lookupArr = Arr.fromList vs        n = Arr.length lookupArr +dualBasis' :: ∀ v . (LinearSpace v, SemiInner (DualVector v), RealFrac' (Scalar v))+                => [DualVector v] -> [Maybe v]+dualBasis' = case dualSpaceWitness :: DualSpaceWitness v of+      DualSpaceWitness -> dualBasis  zipTravWith :: Hask.Traversable t => (a->b->c) -> t a -> [b] -> Maybe (t c) zipTravWith f = evalStateT . Hask.traverse zp@@ -772,7 +776,9 @@         squareV v           : [ (squareV (v^+^w) ^-^ squareV v ^-^ squareV w) ^* sqrt¹₂ | w <- vs ]    where sqrt¹₂ = sqrt 0.5-  subbasisDimension (SymTensBasis b) = ((n-1)*n)`quot`2+  subbasisDimension (SymTensBasis b) = (n*(n+1))`quot`2+                           -- dim Sym(𝑘,𝑉) = nCr (dim 𝑉 + 𝑘 - 1, 𝑘)+                           -- dim Sym(2,𝑉) = nCr (𝑛 + 1, 2) = 𝑛⋅(𝑛+1)/2    where n = subbasisDimension b   decomposeLinMap = dclm dualSpaceWitness    where dclm (DualSpaceWitness :: DualSpaceWitness v) (LinearMap f)@@ -1069,6 +1075,15 @@ instance Show (LinearMap ℝ (V2 ℝ) ℝ) where showsPrec = showsPrecAsRiesz instance Show (LinearMap ℝ (V3 ℝ) ℝ) where showsPrec = showsPrecAsRiesz instance Show (LinearMap ℝ (V4 ℝ) ℝ) where showsPrec = showsPrecAsRiesz+instance ∀ s v w .+         ( FiniteDimensional v, InnerSpace v, Show v+         , FiniteDimensional w, InnerSpace w, Show w+         , Scalar v ~ s, Scalar w ~ s+         , HasBasis s, Basis s ~ () )+         => Show (LinearMap s (v,w) s ) where+  showsPrec = case ( dualSpaceWitness :: DualSpaceWitness v+                   , dualSpaceWitness :: DualSpaceWitness w ) of+      (DualSpaceWitness, DualSpaceWitness) -> showsPrecAsRiesz  class TensorDecomposable u => RieszDecomposable u where   rieszDecomposition :: (FiniteDimensional v, v ~ DualVector v, Scalar v ~ Scalar u)

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                linearmap-category-version:             0.3.2.0+version:             0.3.4.0 synopsis:            Native, complete, matrix-free linear algebra. description:         The term /numerical linear algebra/ is often used almost                      synonymous with /matrix modifications/. However, what's interesting@@ -43,17 +43,18 @@                        Math.LinearMap.Category.Derivatives   other-modules:       Math.LinearMap.Category.Class                        Math.LinearMap.Asserted+                       Math.LinearMap.Category.TensorQuot                        Math.LinearMap.Category.Instances                        Math.VectorSpace.Docile   other-extensions:    FlexibleInstances, UndecidableInstances, FunctionalDependencies, TypeOperators, TypeFamilies   build-depends:       base >=4.8 && <5,-                       vector-space >=0.10 && <0.11,+                       vector-space >=0.11 && <0.12,                        constrained-categories >=0.3 && <0.4,                        containers, vector,                        tagged,-                       free-vector-spaces >= 0.1.2 && < 0.2,+                       free-vector-spaces >= 0.1.4 && < 0.2,                        linear, lens, transformers,-                       manifolds-core >= 0.4 && < 0.5,+                       manifolds-core >= 0.4.4 && < 0.5,                        semigroups,                        ieee754 >= 0.7 && < 0.9   -- hs-source-dirs: