-- |
-- Module      : Data.Manifold.Function.LocalModel
-- Copyright   : (c) Justus Sagemüller 2017
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsagemue $ uni-koeln.de
-- Stability   : experimental
-- Portability : portable
-- 

{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE UnicodeSyntax            #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE TupleSections            #-}
{-# LANGUAGE TypeFamilies             #-}
{-# LANGUAGE UndecidableInstances     #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE StandaloneDeriving       #-}
{-# LANGUAGE TemplateHaskell          #-}
{-# LANGUAGE ConstraintKinds          #-}

module Data.Manifold.Function.LocalModel (
    -- * The model class
      LocalModel (..), ModellableRelation
    -- ** Local data fit models
    , AffineModel(..), QuadraticModel(..)
    , estimateLocalJacobian, estimateLocalHessian
    , propagationCenteredModel
    , propagationCenteredQuadraticModel
    , quadraticModel_derivatives
    -- ** Differential equations
    , DifferentialEqn, LocalDifferentialEqn(..)
    , propagateDEqnSolution_loc, LocalDataPropPlan(..)
    ) where


import Data.Manifold.Types
import Data.Manifold.PseudoAffine
import Data.Manifold.WithBoundary
import Data.Manifold.Types.Primitive ((^))
import Data.Manifold.Shade
import Data.Manifold.Riemannian

import Data.VectorSpace
import Math.LinearMap.Category

import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE

import qualified Prelude as Hask

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

import Control.Lens
import Control.Lens.TH


newtype LocalDifferentialEqn ㄇ x y = LocalDifferentialEqn {
      forall (ㄇ :: * -> * -> *) x y.
LocalDifferentialEqn ㄇ x y
-> ㄇ x y -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y)))
_rescanDifferentialEqn :: ㄇ x y
                             -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y)))
    }
makeLenses ''LocalDifferentialEqn

type DifferentialEqn ㄇ x y = Shade (x,y) -> LocalDifferentialEqn ㄇ x y

data LocalDataPropPlan x y = LocalDataPropPlan
       { forall x y. LocalDataPropPlan x y -> x
_sourcePosition :: !x
       , forall x y. LocalDataPropPlan x y -> Needle x
_targetPosOffset :: !(Needle x)
       , forall x y. LocalDataPropPlan x y -> y
_sourceData, forall x y. LocalDataPropPlan x y -> y
_targetAPrioriData :: !y
       , forall x y. LocalDataPropPlan x y -> [(Needle x, y)]
_relatedData :: [(Needle x, y)]
       }
deriving instance (Show x, Show y, Show (Needle x))
             => Show (LocalDataPropPlan x y)

makeLenses ''LocalDataPropPlan


{-# DEPRECATED estimateLocalJacobian "Use `fitLocally`" #-}
estimateLocalJacobian :: ∀ x y . ( WithField ℝ Manifold x, Refinable y
                                 , SimpleSpace (Needle x), SimpleSpace (Needle y) )
            => Metric x -> [(Local x, Shade' y)]
                             -> Maybe (Shade' (LocalLinear x y))
estimateLocalJacobian :: forall x y.
(WithField Double Manifold x, Refinable y, SimpleSpace (Needle x),
 SimpleSpace (Needle y)) =>
Metric x
-> [(Local x, Shade' y)] -> Maybe (Shade' (LocalLinear x y))
estimateLocalJacobian = (PseudoAffineWitness x, PseudoAffineWitness y)
-> Norm (Needle x)
-> [(Local x, Shade' y)]
-> Maybe (Shade' (LinearMap Double (Needle x) (Needle y)))
elj ( forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness x
                            , forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness y )
 where elj :: (PseudoAffineWitness x, PseudoAffineWitness y)
-> Norm (Needle x)
-> [(Local x, Shade' y)]
-> Maybe (Shade' (LinearMap Double (Needle x) (Needle y)))
elj ( PseudoAffineWitness SemimanifoldWitness x
SemimanifoldWitness
           , PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness )
        Norm (Needle x)
mex [(Local Needle x
x₁, Shade' y
y₁ Metric y
ey₁),(Local Needle x
x₀, Shade' y
y₀ Metric y
ey₀)]
         = forall (m :: * -> *) a. Monad m (->) => a -> m a
return forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x. x -> Metric x -> Shade' x
Shade' (Needle' x
dxforall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LSpace u, LSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
DualVector u -> v -> f u v
-+|>Needle y
δy)
                          (forall v. (v -+> DualVector v) -> Norm v
Norm forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearMap Double (Needle x) (Needle y)
δj -> Needle (Needle x)
δx forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v,
 Num' (Scalar v)) =>
v -> w -> v ⊗ w
⊗ (Metric y
σeyforall v. LSpace v => Norm v -> v -> DualVector v
<$|LinearMap Double (Needle x) (Needle y)
δj forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle (Needle x)
δx))
        where Just Needle (Needle x)
δx = Needle x
x₁forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.Needle x
x₀
              δx' :: Needle' x
δx' = (Norm (Needle x)
mexforall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle (Needle x)
δx)
              dx :: Needle' x
dx = Needle' x
δx'forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/(Needle' x
δx'forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle (Needle x)
δx)
              Just Needle y
δy = y
y₁forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.y
y₀
              σey :: Metric y
σey = forall y (p :: * -> *).
(Refinable y, Functor p) =>
p y -> Metric y -> Metric y -> Metric y
convolveMetric ([]::[y]) Metric y
ey₀ Metric y
ey₁
       elj (PseudoAffineWitness x, PseudoAffineWitness y)
_ Norm (Needle x)
mex ((Local x, Shade' y)
po:[(Local x, Shade' y)]
ps)
           | DualSpaceWitness (Needle y)
DualSpaceWitness <- forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness y
           , forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Local x, Shade' y)]
ps forall a. Ord a => a -> a -> Bool
> Int
1
               = forall y.
(WithField Double Manifold y, SimpleSpace (Needle y)) =>
NonEmpty (Shade' y) -> Maybe (Shade' y)
mixShade's forall (m :: * -> *) (k :: * -> * -> *) a b.
(Monad m k, Object k a, Object k b, Object k (m a), Object k (m b),
 Object k (m (m b))) =>
k a (m b) -> k (m a) (m b)
=<< forall a. a -> [a] -> NonEmpty a
(:|) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall x y.
(WithField Double Manifold x, Refinable y, SimpleSpace (Needle x),
 SimpleSpace (Needle y)) =>
Metric x
-> [(Local x, Shade' y)] -> Maybe (Shade' (LocalLinear x y))
estimateLocalJacobian Norm (Needle x)
mex [(Local x, Shade' y)]
ps 
                             forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
 ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
 ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
 Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [forall x y.
(WithField Double Manifold x, Refinable y, SimpleSpace (Needle x),
 SimpleSpace (Needle y)) =>
Metric x
-> [(Local x, Shade' y)] -> Maybe (Shade' (LocalLinear x y))
estimateLocalJacobian Norm (Needle x)
mex [(Local x, Shade' y)
po,(Local x, Shade' y)
pi] | (Local x, Shade' y)
pi<-[(Local x, Shade' y)]
ps]
       elj (PseudoAffineWitness x, PseudoAffineWitness y)
_ Norm (Needle x)
_ [(Local x, Shade' y)]
_ = forall (m :: * -> *) a. Monad m (->) => a -> m a
return forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x. x -> Metric x -> Shade' x
Shade' forall v. AdditiveGroup v => v
zeroV forall a. Monoid a => a
mempty


data AffineModel x y = AffineModel {
         forall x y. AffineModel x y -> Shade y
_affineModelOffset :: Shade                      y
       , forall x y. AffineModel x y -> Shade (Needle x +> Needle y)
_affineModelLCoeff :: Shade ( Needle x  +>Needle y)
       }
deriving instance (Show (Shade y), Show (Shade (Needle x+>Needle y)))
              => Show (AffineModel x y)
makeLenses ''AffineModel


data QuadraticModel x y = QuadraticModel {
         forall x y. QuadraticModel x y -> Shade y
_quadraticModelOffset :: Shade                      y
       , forall x y. QuadraticModel x y -> Shade (Needle x +> Needle y)
_quadraticModelLCoeff :: Shade ( Needle x  +>Needle y)
       , forall x y. QuadraticModel x y -> Shade (Needle x ⊗〃+> Needle y)
_quadraticModelQCoeff :: Shade (Needle x⊗〃+>Needle y)
       }
deriving instance ( Show (Shade y)
                  , Show (Shade (Needle x+>Needle y))
                  , Show (Shade (Needle x⊗〃+>Needle y)) )
              => Show (QuadraticModel x y)
makeLenses ''QuadraticModel

type QModelTup s x y = ( Needle y, (Needle x+>Needle y
                                 , SymmetricTensor s (Needle x)+>(Needle y)) )



quadratic_linearRegression :: ∀ x y s .
                      ( WithField s PseudoAffine x
                      , WithField s PseudoAffine y, Geodesic y
                      , SimpleSpace (Needle x), SimpleSpace (Needle y) )
            => NE.NonEmpty (Needle x, Shade' y) -> QuadraticModel x y
quadratic_linearRegression :: forall x y s.
(WithField s PseudoAffine x, WithField s PseudoAffine y,
 Geodesic y, SimpleSpace (Needle x), SimpleSpace (Needle y)) =>
NonEmpty (Needle x, Shade' y) -> QuadraticModel x y
quadratic_linearRegression = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                                  , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle y) ) of
    (DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle y)
DualSpaceWitness) -> forall x y (ㄇ :: * -> * -> *) ψ s.
(WithField s PseudoAffine x, WithField s PseudoAffine y,
 Geodesic y, SimpleSpace (Needle x), SimpleSpace (Needle y),
 SimpleSpace ψ, Scalar ψ ~ s) =>
(Needle x -> ψ -+> Needle y)
-> (y -> ψ -> Variance ψ -> ㄇ x y)
-> NonEmpty (Needle x, Shade' y)
-> ㄇ x y
gLinearRegression
         (\Needle x
δx -> forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Needle y
c,(LinearMap s (Needle x) (Needle y)
b,LinearMap
  s (SymmetricTensor (Scalar (Needle x)) (Needle x)) (Needle y)
a)) -> (LinearMap
  s (SymmetricTensor (Scalar (Needle x)) (Needle x)) (Needle y)
a forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV Needle x
δx) forall v. AdditiveGroup v => v -> v -> v
^+^ (LinearMap s (Needle x) (Needle y)
b forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx) forall v. AdditiveGroup v => v -> v -> v
^+^ Needle y
c )
         (\y
cmy (Needle y
cBest, (LinearMap s (Needle x) (Needle y)
bBest, LinearMap
  s (SymmetricTensor (Scalar (Needle x)) (Needle x)) (Needle y)
aBest)) Variance
  (Needle y,
   (LinearMap s (Needle x) (Needle y),
    LinearMap
      s (SymmetricTensor (Scalar (Needle x)) (Needle x)) (Needle y)))
σ
            -> let (Norm (Needle' y)
σc, (Norm (DualVector (LinearMap s (Needle x) (Needle y)))
σb, Norm
  (DualVector
     (LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
σa)) = forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms Variance
  (Needle y,
   (LinearMap s (Needle x) (Needle y),
    LinearMap
      s (SymmetricTensor (Scalar (Needle x)) (Needle x)) (Needle y)))
σ
               in forall x y.
Shade y
-> Shade (Needle x +> Needle y)
-> Shade (Needle x ⊗〃+> Needle y)
-> QuadraticModel x y
QuadraticModel (forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (y
cmyforall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
cBest) Norm (Needle' y)
σc)
                              (forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade LinearMap s (Needle x) (Needle y)
bBest Norm (DualVector (LinearMap s (Needle x) (Needle y)))
σb)
                              (forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade LinearMap
  s (SymmetricTensor (Scalar (Needle x)) (Needle x)) (Needle y)
aBest Norm
  (DualVector
     (LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
σa) )

gLinearRegression :: ∀ x y ㄇ ψ s .
                      ( WithField s PseudoAffine x
                      , WithField s PseudoAffine y, Geodesic y
                      , SimpleSpace (Needle x), SimpleSpace (Needle y)
                      , SimpleSpace ψ, Scalar ψ ~ s )
            => (Needle x -> ψ -+> Needle y)
               -> (y -> ψ -> Variance ψ -> ㄇ x y)
               -> NE.NonEmpty (Needle x, Shade' y) -> ㄇ x y
gLinearRegression :: forall x y (ㄇ :: * -> * -> *) ψ s.
(WithField s PseudoAffine x, WithField s PseudoAffine y,
 Geodesic y, SimpleSpace (Needle x), SimpleSpace (Needle y),
 SimpleSpace ψ, Scalar ψ ~ s) =>
(Needle x -> ψ -+> Needle y)
-> (y -> ψ -> Variance ψ -> ㄇ x y)
-> NonEmpty (Needle x, Shade' y)
-> ㄇ x y
gLinearRegression Needle x -> ψ -+> Needle y
fwdCalc y -> ψ -> Variance ψ -> ㄇ x y
analyse = PseudoAffineWitness y -> NonEmpty (Needle x, Shade' y) -> ㄇ x y
qlr (forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness)
 where qlr :: (PseudoAffineWitness y)
                   -> NE.NonEmpty (Needle x, Shade' y) -> ㄇ x y
       qlr :: PseudoAffineWitness y -> NonEmpty (Needle x, Shade' y) -> ㄇ x y
qlr (PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness) NonEmpty (Needle x, Shade' y)
ps
                 = y -> ψ -> Variance ψ -> ㄇ x y
analyse y
cmy ψ
ψ Variance ψ
σψ
        where Just y
cmy = forall m. Geodesic m => NonEmpty m -> Maybe m
pointsBarycenter forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x. Shade' x -> x
_shade'Ctrforall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
sndforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>NonEmpty (Needle x, Shade' y)
ps
              Just NonEmpty (Needle x, (Needle y, Norm (Needle y)))
vsxy = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
Hask.mapM (\(Needle x
x, Shade' y
y Norm (Needle y)
ey) -> (Needle x
x,)forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.(,Norm (Needle y)
ey)forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>y
yforall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.y
cmy) NonEmpty (Needle x, Shade' y)
ps
              ψ :: ψ
ψ = forall x y m. LinearRegressionResult x y m -> m
linearFit_bestModel LinearRegressionResult (Needle x) (Needle y) ψ
regResult
              σψ :: Variance ψ
σψ = forall v. SimpleSpace v => Norm v -> Variance v
dualNorm forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (case forall x y m. LinearRegressionResult x y m -> Scalar m
linearFit_χν² LinearRegressionResult (Needle x) (Needle y) ψ
regResult of
                                     Scalar ψ
χν² | Scalar ψ
χν² forall a. Ord a => a -> a -> Bool
> s
0, forall a. Fractional a => a -> a
recip Scalar ψ
χν² forall a. Ord a => a -> a -> Bool
> s
0
                                            -> forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm (forall a. Fractional a => a -> a
recip forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s
1 forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sqrt Scalar ψ
χν²)
                                     Scalar ψ
_ -> {-Dbg.trace ("Fit for regression model requires"
               ++" well-defined χν² (which needs positive number of degrees of freedom)."
               ++"\n Data: "++show (length ps
                                * subbasisDimension (entireBasis :: SubBasis (Needle y)))
               ++"\n Model parameters: "++show (subbasisDimension
                                        (entireBasis :: SubBasis ψ)) )-}
                                          forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
                                forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y m. LinearRegressionResult x y m -> Norm m
linearFit_modelUncertainty LinearRegressionResult (Needle x) (Needle y) ψ
regResult
              regResult :: LinearRegressionResult (Needle x) (Needle y) ψ
regResult = forall 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 (forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Needle x -> ψ -+> Needle y
fwdCalc) (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Needle x, (Needle y, Norm (Needle y)))
vsxy)

quadraticModel_derivatives :: ∀ x y .
          ( PseudoAffine x, PseudoAffine y
          , SimpleSpace (Needle x), SimpleSpace (Needle y)
          , Scalar (Needle y) ~ Scalar (Needle x) ) =>
     QuadraticModel x y -> (Shade' y, (Shade' (LocalLinear x y), Shade' (LocalBilinear x y))) 
quadraticModel_derivatives :: forall x y.
(PseudoAffine x, PseudoAffine y, SimpleSpace (Needle x),
 SimpleSpace (Needle y), Scalar (Needle y) ~ Scalar (Needle x)) =>
QuadraticModel x y
-> (Shade' y,
    (Shade' (LocalLinear x y), Shade' (LocalBilinear x y)))
quadraticModel_derivatives (QuadraticModel Shade y
sh Shade (Needle x +> Needle y)
shð Shade (Needle x ⊗〃+> Needle y)
shð²)
    | (PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness)
                                     :: PseudoAffineWitness y <- forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness
    , DualSpaceWitness (Needle x)
DualSpaceWitness :: DualSpaceWitness (Needle x) <- forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
    , DualSpaceWitness (Needle y)
DualSpaceWitness :: DualSpaceWitness (Needle y) <- forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
             = (forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade y
sh, ( forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade (Needle x +> Needle y)
shð
                              , forall (shade :: * -> *) x y.
(IsShade shade, SimpleSpace x, SimpleSpace y, Scalar x ~ Scalar y,
 Num' (Scalar x)) =>
(x +> y) -> shade x -> shade y
linIsoTransformShade (Scalar (Needle x)
2forall v. VectorSpace v => Scalar v -> v -> v
*^forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade (Needle x ⊗〃+> Needle y)
shð² ))

{-# DEPRECATED estimateLocalHessian "Use `fitLocally`" #-}
estimateLocalHessian :: ∀ x y . ( WithField ℝ Manifold x, Refinable y, Geodesic y
                                , FlatSpace (Needle x), FlatSpace (Needle y) )
            => NonEmpty (Local x, Shade' y) -> QuadraticModel x y
estimateLocalHessian :: forall x y.
(WithField Double Manifold x, Refinable y, Geodesic y,
 FlatSpace (Needle x), FlatSpace (Needle y)) =>
NonEmpty (Local x, Shade' y) -> QuadraticModel x y
estimateLocalHessian NonEmpty (Local x, Shade' y)
pts = forall x y s.
(WithField s PseudoAffine x, WithField s PseudoAffine y,
 Geodesic y, SimpleSpace (Needle x), SimpleSpace (Needle y)) =>
NonEmpty (Needle x, Shade' y) -> QuadraticModel x y
quadratic_linearRegression forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first forall x. Local x -> Needle x
getLocalOffset forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> NonEmpty (Local x, Shade' y)
pts


propagationCenteredModel :: ∀ x y ㄇ .
                         ( ModellableRelation x y, LocalModel ㄇ )
         => LocalDataPropPlan x (Shade' y) -> ㄇ x y
propagationCenteredModel :: forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
LocalDataPropPlan x (Shade' y) -> ㄇ x y
propagationCenteredModel LocalDataPropPlan x (Shade' y)
propPlan = case forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally (forall a. NonEmpty a -> [a]
NE.toList NonEmpty (Needle x, Shade' y)
ptsFromCenter) of
                                       Just ㄇ x y
ㄇ->ㄇ x y
ㄇ
 where ctrOffset :: Needle x
ctrOffset = LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffsetforall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/Scalar (Needle x)
2
       ptsFromCenter :: NonEmpty (Needle x, Shade' y)
ptsFromCenter = (forall v. AdditiveGroup v => v -> v
negateV Needle x
ctrOffset, LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) y
sourceData)
                     forall a. a -> [a] -> NonEmpty a
:| [(Needle x
δxforall v. AdditiveGroup v => v -> v -> v
^-^Needle x
ctrOffset, Shade' y
shy)
                        | (Needle x
δx, Shade' y
shy)
                            <- (LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffset, LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) y
targetAPrioriData)
                               forall a. a -> [a] -> [a]
: LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) [(Needle x, y)]
relatedData
                        ]


propagationCenteredQuadraticModel :: ∀ x y .
                         ( ModellableRelation x y )
         => LocalDataPropPlan x (Shade' y) -> QuadraticModel x y
propagationCenteredQuadraticModel :: forall x y.
ModellableRelation x y =>
LocalDataPropPlan x (Shade' y) -> QuadraticModel x y
propagationCenteredQuadraticModel = forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
LocalDataPropPlan x (Shade' y) -> ㄇ x y
propagationCenteredModel


propagateDEqnSolution_loc :: ∀ x y ㄇ . (ModellableRelation x y, LocalModel ㄇ)
           => DifferentialEqn ㄇ x y
               -> LocalDataPropPlan x (Shade' y)
               -> Maybe (Shade' y)
propagateDEqnSolution_loc :: forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
DifferentialEqn ㄇ x y
-> LocalDataPropPlan x (Shade' y) -> Maybe (Shade' y)
propagateDEqnSolution_loc DifferentialEqn ㄇ x y
f LocalDataPropPlan x (Shade' y)
propPlan
                  = DualSpaceWitness (Needle x)
-> DualSpaceWitness (Needle y)
-> PseudoAffineWitness y
-> Maybe (Shade' y)
pdesl (forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x)
                          (forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness y)
                          (forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness y)
 where pdesl :: DualSpaceWitness (Needle x)
-> DualSpaceWitness (Needle y)
-> PseudoAffineWitness y
-> Maybe (Shade' y)
pdesl DualSpaceWitness (Needle x)
DualSpaceWitness DualSpaceWitness (Needle y)
DualSpaceWitness
             (PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness)
          | Maybe
  (Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
Nothing <- Maybe
  (Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
jacobian  = forall a. Maybe a
Nothing
          | Bool
otherwise            = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Shade' y
result
         where (Maybe (Shade' y)
_,Maybe
  (Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
jacobian) = DifferentialEqn ㄇ x y
f Shade (x, y)
shxy forall s a. s -> Getting a s a -> a
^. forall (ㄇ :: * -> * -> *) x y (ㄇ :: * -> * -> *) x y.
Iso
  (LocalDifferentialEqn ㄇ x y)
  (LocalDifferentialEqn ㄇ x y)
  (ㄇ x y -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y))))
  (ㄇ x y -> (Maybe (Shade' y), Maybe (Shade' (LocalLinear x y))))
rescanDifferentialEqn
                               forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y (ㄇ :: * -> * -> *).
(ModellableRelation x y, LocalModel ㄇ) =>
LocalDataPropPlan x (Shade' y) -> ㄇ x y
propagationCenteredModel LocalDataPropPlan x (Shade' y)
propPlan
               jacobianSh :: Shade (LocalLinear x y)
               Just Shade (LinearMap Double (Needle x) (Needle y))
Shade (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
jacobianSh = forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade' x -> Shade x
dualShade' forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Maybe
  (Shade' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)))
jacobian
               mx :: x
mx = LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) x
sourcePosition forall x. Semimanifold x => x -> Needle x -> x
.+~^ LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffset forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Scalar (Needle x)
2 :: x
               (Shade x
_ Norm (Needle' x)
expax' :: Shade x)
                    = forall x s.
(Fractional' s, WithField s PseudoAffine x,
 SimpleSpace (Needle x)) =>
x -> [Needle x] -> Shade x
coverAllAround (LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) x
sourcePosition)
                                     [Needle x
δx | (Needle x
δx,Shade' y
_) <- LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) [(Needle x, y)]
relatedData]
               shxy :: Shade (x, y)
shxy = forall x s.
(Fractional' s, WithField s PseudoAffine x,
 SimpleSpace (Needle x)) =>
x -> [Needle x] -> Shade x
coverAllAround (x
mx, y
mυ)
                                     [ (Needle x
δx forall v. AdditiveGroup v => v -> v -> v
^-^ LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffset forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Double
2, Needle y
pυ forall v. AdditiveGroup v => v -> v -> v
^+^ Needle y
v)
                                     | (Needle x
δx,Shade' y
neυ) <- (forall v. AdditiveGroup v => v
zeroV, LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) y
sourceData)
                                                  forall a. a -> [a] -> [a]
: (forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
                                                      forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) [(Needle x, y)]
relatedData)
                                     , let Just Needle y
pυ = Shade' y
neυforall s a. s -> Getting a s a -> a
^.forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. y
mυ
                                     , Needle y
v <- forall v.
(FiniteDimensional v, IEEE (Scalar v)) =>
Seminorm v -> [v]
normSpanningSystem' (Shade' y
neυforall s a. s -> Getting a s a -> a
^.forall x. Lens' (Shade' x) (Metric x)
shadeNarrowness)
                                     ]
                where Just y
mυ = forall x. Geodesic x => x -> x -> Maybe x
middleBetween (LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) y
sourceDataforall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr)
                                              (LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) y
targetAPrioriDataforall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr)
               expax :: Variance (Needle' x)
expax = forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Norm (Needle' x)
expax'
               result :: Shade' y
               result :: Shade' y
result = forall y. Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
convolveShade' (LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) y
sourceData)
                             (forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall x y s.
(Num' s, LinearSpace x, SimpleSpace y, Scalar x ~ s,
 Scalar y ~ s) =>
(x +> y) -> Shade x -> Shade y
linearProjectShade (forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun (forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
jacobianSh)
               δx :: Needle x
δx = LocalDataPropPlan x (Shade' y)
propPlanforall s a. s -> Getting a s a -> a
^.forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffset


type ModellableRelation x y = ( WithField ℝ Manifold x
                              , Refinable y, Geodesic y
                              , FlatSpace (Needle x), FlatSpace (Needle y) )

class LocalModel ㄇ where
  fitLocally :: ModellableRelation x y
                  => [(Needle x, Shade' y)] -> Maybe (ㄇ x y)
  tweakLocalOffset :: ModellableRelation x y
                  => Lens' (ㄇ x y) (Shade y)
  evalLocalModel :: ModellableRelation x y => ㄇ x y -> Needle x -> Shade' y

modelParametersOverdetMargin :: Int -> Int
modelParametersOverdetMargin :: Int -> Int
modelParametersOverdetMargin Int
n = Int
n forall a. Num a => a -> a -> a
+ forall a b. (RealFrac a, Integral b) => a -> b
round (forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) forall a. Num a => a -> a -> a
- Int
1


-- | Dimension of the space of affine functions on @v@.
p¹Dimension :: ∀ v p . FiniteDimensional v => p v -> Int
p¹Dimension :: forall v (p :: * -> *). FiniteDimensional v => p v -> Int
p¹Dimension p v
_ = Int
1 forall a. Num a => a -> a -> a
+ Int
d
 where d :: Int
d = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis v)

-- | Dimension of the space of quadratic functions on @v@.
p²Dimension :: ∀ v p . FiniteDimensional v => p v -> Int
p²Dimension :: forall v (p :: * -> *). FiniteDimensional v => p v -> Int
p²Dimension p v
_ = Int
1 forall a. Num a => a -> a -> a
+ Int
d forall a. Num a => a -> a -> a
+ (Int
dforall a. Num a => a -> a -> a
*(Int
dforall a. Num a => a -> a -> a
+Int
1))forall a. Integral a => a -> a -> a
`div`Int
2
 where d :: Int
d = forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis v)

instance LocalModel AffineModel where
  fitLocally :: forall x y.
ModellableRelation x y =>
[(Needle x, Shade' y)] -> Maybe (AffineModel x y)
fitLocally = forall x y.
ModellableRelation x y =>
DualSpaceWitness (Needle y)
-> [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
aFitL forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
   where aFitL :: ∀ x y . ModellableRelation x y
                    => DualSpaceWitness (Needle y)
                      -> [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
         aFitL :: forall x y.
ModellableRelation x y =>
DualSpaceWitness (Needle y)
-> [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
aFitL DualSpaceWitness (Needle y)
DualSpaceWitness [(Needle x, Shade' y)]
dataPts
          | ((Needle x, Shade' y)
p₀:[(Needle x, Shade' y)]
ps, (Needle x, Shade' y)
pω:[(Needle x, Shade' y)]
_) <- forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
modelParametersOverdetMargin
                                        forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v (p :: * -> *). FiniteDimensional v => p v -> Int
p¹Dimension ([]::[Needle x])) [(Needle x, Shade' y)]
dataPts
                 = forall a. a -> Maybe a
Just forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall x y (ㄇ :: * -> * -> *) ψ s.
(WithField s PseudoAffine x, WithField s PseudoAffine y,
 Geodesic y, SimpleSpace (Needle x), SimpleSpace (Needle y),
 SimpleSpace ψ, Scalar ψ ~ s) =>
(Needle x -> ψ -+> Needle y)
-> (y -> ψ -> Variance ψ -> ㄇ x y)
-> NonEmpty (Needle x, Shade' y)
-> ㄇ x y
gLinearRegression
                            (\Needle x
δx -> forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Needle y
b,LinearMap Double (Needle x) (Needle y)
a) -> (LinearMap Double (Needle x) (Needle y)
a forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx) forall v. AdditiveGroup v => v -> v -> v
^+^ Needle y
b )
                            (\y
cmy (Needle y
bBest, LinearMap Double (Needle x) (Needle y)
aBest) Variance (Needle y, LinearMap Double (Needle x) (Needle y))
σ
                               -> let (Norm (Needle' y)
σb, Norm (DualVector (LinearMap Double (Needle x) (Needle y)))
σa) = forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms Variance (Needle y, LinearMap Double (Needle x) (Needle y))
σ
                                  in forall x y.
Shade y -> Shade (Needle x +> Needle y) -> AffineModel x y
AffineModel (forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (y
cmyforall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
bBest)
                                                        forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm Double
2 Norm (Needle' y)
σb)
                               -- The magic factor 2 seems dubious ↗, but testing indicates
                               -- that this is necessary to not overrate the accuracy.
                               --   TODO:  check the algorithms in linearmap-category.
                                                 (forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade LinearMap Double (Needle x) (Needle y)
aBest Norm (DualVector (LinearMap Double (Needle x) (Needle y)))
σa) )
                     forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Needle x, Shade' y)
p₀forall a. a -> [a] -> NonEmpty a
:|[(Needle x, Shade' y)]
psforall a. [a] -> [a] -> [a]
++[(Needle x, Shade' y)
pω])
          | Bool
otherwise  = forall a. Maybe a
Nothing
  tweakLocalOffset :: forall x y.
ModellableRelation x y =>
Lens' (AffineModel x y) (Shade y)
tweakLocalOffset = forall x y. Lens' (AffineModel x y) (Shade y)
affineModelOffset
  evalLocalModel :: forall x y.
ModellableRelation x y =>
AffineModel x y -> Needle x -> Shade' y
evalLocalModel = forall x y.
ModellableRelation x y =>
PseudoAffineWitness y -> AffineModel x y -> Needle x -> Shade' y
aEvL forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness
   where aEvL :: ∀ x y . ModellableRelation x y
                => PseudoAffineWitness y -> AffineModel x y -> Needle x -> Shade' y
         aEvL :: forall x y.
ModellableRelation x y =>
PseudoAffineWitness y -> AffineModel x y -> Needle x -> Shade' y
aEvL (PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness) (AffineModel Shade y
shy₀ Shade (Needle x +> Needle y)
shj) Needle x
δx
          = forall y. Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
convolveShade' (forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade y
shy₀)
                           (forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall x y s.
(Num' s, LinearSpace x, SimpleSpace y, Scalar x ~ s,
 Scalar y ~ s) =>
(x +> y) -> Shade x -> Shade y
linearProjectShade (forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun (forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (Needle x +> Needle y)
shj)

instance LocalModel QuadraticModel where
  fitLocally :: forall x y.
ModellableRelation x y =>
[(Needle x, Shade' y)] -> Maybe (QuadraticModel x y)
fitLocally = forall x y.
ModellableRelation x y =>
[(Needle x, Shade' y)] -> Maybe (QuadraticModel x y)
qFitL
   where qFitL :: ∀ x y . ModellableRelation x y
                    => [(Needle x, Shade' y)] -> Maybe (QuadraticModel x y)
         qFitL :: forall x y.
ModellableRelation x y =>
[(Needle x, Shade' y)] -> Maybe (QuadraticModel x y)
qFitL [(Needle x, Shade' y)]
dataPts
          | ((Needle x, Shade' y)
p₀:[(Needle x, Shade' y)]
ps, (Needle x, Shade' y)
pω:[(Needle x, Shade' y)]
_) <- forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
modelParametersOverdetMargin
                                        forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v (p :: * -> *). FiniteDimensional v => p v -> Int
p²Dimension ([]::[Needle x])) [(Needle x, Shade' y)]
dataPts
                 = forall a. a -> Maybe a
Just forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall x y s.
(WithField s PseudoAffine x, WithField s PseudoAffine y,
 Geodesic y, SimpleSpace (Needle x), SimpleSpace (Needle y)) =>
NonEmpty (Needle x, Shade' y) -> QuadraticModel x y
quadratic_linearRegression
                     forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Needle x, Shade' y)
p₀forall a. a -> [a] -> NonEmpty a
:|[(Needle x, Shade' y)]
psforall a. [a] -> [a] -> [a]
++[(Needle x, Shade' y)
pω])
          | Bool
otherwise  = forall a. Maybe a
Nothing
  tweakLocalOffset :: forall x y.
ModellableRelation x y =>
Lens' (QuadraticModel x y) (Shade y)
tweakLocalOffset = forall x y. Lens' (QuadraticModel x y) (Shade y)
quadraticModelOffset
  evalLocalModel :: forall x y.
ModellableRelation x y =>
QuadraticModel x y -> Needle x -> Shade' y
evalLocalModel = forall x y.
ModellableRelation x y =>
PseudoAffineWitness y -> QuadraticModel x y -> Needle x -> Shade' y
aEvL forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness
   where aEvL :: ∀ x y . ModellableRelation x y
                => PseudoAffineWitness y -> QuadraticModel x y -> Needle x -> Shade' y
         aEvL :: forall x y.
ModellableRelation x y =>
PseudoAffineWitness y -> QuadraticModel x y -> Needle x -> Shade' y
aEvL (PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness)
              (QuadraticModel Shade y
shy₀ Shade (Needle x +> Needle y)
shj Shade (Needle x ⊗〃+> Needle y)
shjj) Needle x
δx
          = (forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade y
shy₀)
           forall y. Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
`convolveShade'`
            (forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall x y s.
(Num' s, LinearSpace x, SimpleSpace y, Scalar x ~ s,
 Scalar y ~ s) =>
(x +> y) -> Shade x -> Shade y
linearProjectShade (forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun (forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (Needle x +> Needle y)
shj)
           forall y. Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
`convolveShade'`
            (forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall x y s.
(Num' s, LinearSpace x, SimpleSpace y, Scalar x ~ s,
 Scalar y ~ s) =>
(x +> y) -> Shade x -> Shade y
linearProjectShade (forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun (forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV Needle x
δx)) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (Needle x ⊗〃+> Needle y)
shjj)