-- |
-- 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 {
      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
       { LocalDataPropPlan x y -> x
_sourcePosition :: !x
       , LocalDataPropPlan x y -> Needle x
_targetPosOffset :: !(Needle x)
       , LocalDataPropPlan x y -> y
_sourceData, LocalDataPropPlan x y -> y
_targetAPrioriData :: !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 :: Metric x
-> [(Local x, Shade' y)] -> Maybe (Shade' (LocalLinear x y))
estimateLocalJacobian = (PseudoAffineWitness x, PseudoAffineWitness y)
-> Metric x
-> [(Local x, Shade' y)]
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
elj ( PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness x
                            , PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness y )
 where elj :: (PseudoAffineWitness x, PseudoAffineWitness y)
-> Metric x
-> [(Local x, Shade' y)]
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
elj ( PseudoAffineWitness SemimanifoldWitness x
SemimanifoldWitness
           , PseudoAffineWitness SemimanifoldWitness )
        Metric x
mex [(Local x₁, Shade' y₁ ey₁),(Local x₀, Shade' y₀ ey₀)]
         = Shade' (LinearMap ℝ (Needle x) (Needle y))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Shade' (LinearMap ℝ (Needle x) (Needle y))
 -> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ (Needle x) (Needle y)
-> Metric (LinearMap ℝ (Needle x) (Needle y))
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
forall x. x -> Metric x -> Shade' x
Shade' (DualVector (Needle x)
dxDualVector (Needle x)
-> Needle y -> LinearMap ℝ (Needle x) (Needle y)
forall (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)
                          (LinearFunction
  ℝ
  (LinearMap ℝ (Needle x) (Needle y))
  (Tensor ℝ (Needle x) (DualVector (Needle y)))
-> Norm (LinearMap ℝ (Needle x) (Needle y))
forall v. (v -+> DualVector v) -> Norm v
Norm (LinearFunction
   ℝ
   (LinearMap ℝ (Needle x) (Needle y))
   (Tensor ℝ (Needle x) (DualVector (Needle y)))
 -> Norm (LinearMap ℝ (Needle x) (Needle y)))
-> ((LinearMap ℝ (Needle x) (Needle y)
     -> Tensor ℝ (Needle x) (DualVector (Needle y)))
    -> LinearFunction
         ℝ
         (LinearMap ℝ (Needle x) (Needle y))
         (Tensor ℝ (Needle x) (DualVector (Needle y))))
-> (LinearMap ℝ (Needle x) (Needle y)
    -> Tensor ℝ (Needle x) (DualVector (Needle y)))
-> Norm (LinearMap ℝ (Needle x) (Needle y))
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
. (LinearMap ℝ (Needle x) (Needle y)
 -> Tensor ℝ (Needle x) (DualVector (Needle y)))
-> LinearFunction
     ℝ
     (LinearMap ℝ (Needle x) (Needle y))
     (Tensor ℝ (Needle x) (DualVector (Needle y)))
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((LinearMap ℝ (Needle x) (Needle y)
  -> Tensor ℝ (Needle x) (DualVector (Needle y)))
 -> Norm (LinearMap ℝ (Needle x) (Needle y)))
-> (LinearMap ℝ (Needle x) (Needle y)
    -> Tensor ℝ (Needle x) (DualVector (Needle y)))
-> Norm (LinearMap ℝ (Needle x) (Needle y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearMap ℝ (Needle x) (Needle y)
δj -> Needle x
δx Needle x
-> DualVector (Needle y) -> Needle x ⊗ DualVector (Needle y)
forall v w.
(TensorSpace v, TensorSpace w, Scalar w ~ Scalar v,
 Num' (Scalar v)) =>
v -> w -> v ⊗ w
⊗ (Metric y
σeyMetric y -> Needle y -> DualVector (Needle y)
forall v. LSpace v => Norm v -> v -> DualVector v
<$|LinearMap ℝ (Needle x) (Needle y)
δj LinearMap ℝ (Needle x) (Needle y) -> Needle x -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx))
        where Just Needle x
δx = Needle x
x₁Needle x -> Needle x -> Maybe (Needle (Needle x))
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.Needle x
x₀
              δx' :: DualVector (Needle x)
δx' = (Metric x
mexMetric x -> Needle x -> DualVector (Needle x)
forall v. LSpace v => Norm v -> v -> DualVector v
<$|Needle x
δx)
              dx :: DualVector (Needle x)
dx = DualVector (Needle x)
δx'DualVector (Needle x) -> ℝ -> DualVector (Needle x)
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/(DualVector (Needle x)
δx'DualVector (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle x
δx)
              Just Needle y
δy = y
y₁y -> y -> Maybe (Needle y)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.y
y₀
              σey :: Metric y
σey = [y] -> Metric y -> Metric y -> Metric y
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)
_ Metric x
mex ((Local x, Shade' y)
po:[(Local x, Shade' y)]
ps)
           | DualSpaceWitness (Needle y)
DualSpaceWitness <- DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness y
           , [(Local x, Shade' y)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Local x, Shade' y)]
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
               = NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y)))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
forall y.
(WithField ℝ Manifold y, SimpleSpace (Needle y)) =>
NonEmpty (Shade' y) -> Maybe (Shade' y)
mixShade's (NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y)))
 -> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
-> Maybe (NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y))))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
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)
=<< Shade' (LinearMap ℝ (Needle x) (Needle y))
-> [Shade' (LinearMap ℝ (Needle x) (Needle y))]
-> NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y)))
forall a. a -> [a] -> NonEmpty a
(:|) (Shade' (LinearMap ℝ (Needle x) (Needle y))
 -> [Shade' (LinearMap ℝ (Needle x) (Needle y))]
 -> NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y))))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
-> Maybe
     ([Shade' (LinearMap ℝ (Needle x) (Needle y))]
      -> NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y))))
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Metric x
-> [(Local x, Shade' y)] -> Maybe (Shade' (LocalLinear x y))
forall 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 Metric x
mex [(Local x, Shade' y)]
ps 
                             Maybe
  ([Shade' (LinearMap ℝ (Needle x) (Needle y))]
   -> NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y))))
-> Maybe [Shade' (LinearMap ℝ (Needle x) (Needle y))]
-> Maybe (NonEmpty (Shade' (LinearMap ℝ (Needle x) (Needle y))))
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))
<*> [Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))]
-> Maybe [Shade' (LinearMap ℝ (Needle x) (Needle y))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Metric x
-> [(Local x, Shade' y)] -> Maybe (Shade' (LocalLinear x y))
forall 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 Metric 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)
_ Metric x
_ [(Local x, Shade' y)]
_ = Shade' (LinearMap ℝ (Needle x) (Needle y))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Shade' (LinearMap ℝ (Needle x) (Needle y))
 -> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ (Needle x) (Needle y)
-> Metric (LinearMap ℝ (Needle x) (Needle y))
-> Shade' (LinearMap ℝ (Needle x) (Needle y))
forall x. x -> Metric x -> Shade' x
Shade' LinearMap ℝ (Needle x) (Needle y)
forall v. AdditiveGroup v => v
zeroV Metric (LinearMap ℝ (Needle x) (Needle y))
forall a. Monoid a => a
mempty


data AffineModel x y = AffineModel {
         AffineModel x y -> Shade y
_affineModelOffset :: Shade                      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 {
         QuadraticModel x y -> Shade y
_quadraticModelOffset :: Shade                      y
       , QuadraticModel x y -> Shade (Needle x +> Needle y)
_quadraticModelLCoeff :: Shade ( Needle x  +>Needle 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 :: NonEmpty (Needle x, Shade' y) -> QuadraticModel x y
quadratic_linearRegression = case ( DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
                                  , DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle y) ) of
    (DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle y)
DualSpaceWitness) -> (Needle x
 -> (Needle y,
     (LinearMap s (Needle x) (Needle y),
      LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
    -+> Needle y)
-> (y
    -> (Needle y,
        (LinearMap s (Needle x) (Needle y),
         LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
    -> Variance
         (Needle y,
          (LinearMap s (Needle x) (Needle y),
           LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
    -> QuadraticModel x y)
-> NonEmpty (Needle x, Shade' y)
-> QuadraticModel x y
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 -> ((Needle y,
  (LinearMap s (Needle x) (Needle y),
   LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
 -> Needle y)
-> LinearFunction
     s
     (Needle y,
      (LinearMap s (Needle x) (Needle y),
       LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
     (Needle y)
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 (((Needle y,
   (LinearMap s (Needle x) (Needle y),
    LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
  -> Needle y)
 -> LinearFunction
      s
      (Needle y,
       (LinearMap s (Needle x) (Needle y),
        LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
      (Needle y))
-> ((Needle y,
     (LinearMap s (Needle x) (Needle y),
      LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
    -> Needle y)
-> LinearFunction
     s
     (Needle y,
      (LinearMap s (Needle x) (Needle y),
       LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
     (Needle y)
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 s (Needle x)) (Needle y)
a)) -> (LinearMap s (SymmetricTensor s (Needle x)) (Needle y)
a LinearMap s (SymmetricTensor s (Needle x)) (Needle y)
-> SymmetricTensor s (Needle x) -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x -> SymmetricTensor s (Needle x)
forall s v.
(Num' s, s ~ Scalar v, TensorSpace v) =>
v -> SymmetricTensor s v
squareV Needle x
δx) Needle y -> Needle y -> Needle y
forall v. AdditiveGroup v => v -> v -> v
^+^ (LinearMap s (Needle x) (Needle y)
b LinearMap s (Needle x) (Needle y) -> Needle x -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx) Needle y -> Needle y -> Needle y
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 s (Needle x)) (Needle y)
aBest)) Variance
  (Needle y,
   (LinearMap s (Needle x) (Needle y),
    LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
σ
            -> let (Norm (DualVector (Needle y))
σc, (Norm (Tensor s (Needle x) (DualVector (Needle y)))
σb, Norm
  (Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y)))
σa)) = (Norm
   (Tensor s (Needle x) (DualVector (Needle y)),
    Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y)))
 -> (Norm (Tensor s (Needle x) (DualVector (Needle y))),
     Norm
       (Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y)))))
-> (Norm (DualVector (Needle y)),
    Norm
      (Tensor s (Needle x) (DualVector (Needle y)),
       Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))
-> (Norm (DualVector (Needle y)),
    (Norm (Tensor s (Needle x) (DualVector (Needle y))),
     Norm
       (Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y)))))
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second Norm
  (Tensor s (Needle x) (DualVector (Needle y)),
   Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y)))
-> (Norm (Tensor s (Needle x) (DualVector (Needle y))),
    Norm
      (Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms ((Norm (DualVector (Needle y)),
  Norm
    (Tensor s (Needle x) (DualVector (Needle y)),
     Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))
 -> (Norm (DualVector (Needle y)),
     (Norm (Tensor s (Needle x) (DualVector (Needle y))),
      Norm
        (Tensor
           s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))))
-> (Norm (DualVector (Needle y)),
    Norm
      (Tensor s (Needle x) (DualVector (Needle y)),
       Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))
-> (Norm (DualVector (Needle y)),
    (Norm (Tensor s (Needle x) (DualVector (Needle y))),
     Norm
       (Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y)))))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Norm
  (DualVector (Needle y),
   (Tensor s (Needle x) (DualVector (Needle y)),
    Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))
-> (Norm (DualVector (Needle y)),
    Norm
      (Tensor s (Needle x) (DualVector (Needle y)),
       Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms Norm
  (DualVector (Needle y),
   (Tensor s (Needle x) (DualVector (Needle y)),
    Tensor s (SymmetricTensor s (Needle x)) (DualVector (Needle y))))
Variance
  (Needle y,
   (LinearMap s (Needle x) (Needle y),
    LinearMap s (SymmetricTensor s (Needle x)) (Needle y)))
σ
               in Shade y
-> Shade (Needle x +> Needle y)
-> Shade (Needle x ⊗〃+> Needle y)
-> QuadraticModel x y
forall x y.
Shade y
-> Shade (Needle x +> Needle y)
-> Shade (Needle x ⊗〃+> Needle y)
-> QuadraticModel x y
QuadraticModel (y -> Norm (DualVector (Needle y)) -> Shade y
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (y
cmyy -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
cBest) Norm (DualVector (Needle y))
σc)
                              (LinearMap s (Needle x) (Needle y)
-> Metric' (LinearMap s (Needle x) (Needle y))
-> Shade (LinearMap s (Needle x) (Needle y))
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade LinearMap s (Needle x) (Needle y)
bBest Metric' (LinearMap s (Needle x) (Needle y))
Norm (Tensor s (Needle x) (DualVector (Needle y)))
σb)
                              (LinearMap s (SymmetricTensor s (Needle x)) (Needle y)
-> Metric' (LinearMap s (SymmetricTensor s (Needle x)) (Needle y))
-> Shade (LinearMap s (SymmetricTensor s (Needle x)) (Needle y))
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade LinearMap s (SymmetricTensor s (Needle x)) (Needle y)
aBest Metric' (LinearMap s (SymmetricTensor s (Needle x)) (Needle y))
Norm
  (Tensor s (SymmetricTensor s (Needle x)) (DualVector (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 :: (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 (PseudoAffineWitness y
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 = NonEmpty y -> Maybe y
forall m. Geodesic m => NonEmpty m -> Maybe m
pointsBarycenter (NonEmpty y -> Maybe y) -> NonEmpty y -> Maybe y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade' y -> y
forall x. Shade' x -> x
_shade'Ctr(Shade' y -> y)
-> ((Needle x, Shade' y) -> Shade' y) -> (Needle x, Shade' y) -> y
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, Shade' y) -> Shade' y
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((Needle x, Shade' y) -> y)
-> NonEmpty (Needle x, Shade' y) -> NonEmpty y
forall (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 = ((Needle x, Shade' y)
 -> Maybe (Needle x, (Needle y, Norm (Needle y))))
-> NonEmpty (Needle x, Shade' y)
-> Maybe (NonEmpty (Needle x, (Needle y, Norm (Needle y))))
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,)((Needle y, Norm (Needle y))
 -> (Needle x, (Needle y, Norm (Needle y))))
-> (Needle y -> (Needle y, Norm (Needle y)))
-> Needle y
-> (Needle x, (Needle y, Norm (Needle y)))
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)(Needle y -> (Needle x, (Needle y, Norm (Needle y))))
-> Maybe (Needle y)
-> Maybe (Needle x, (Needle y, Norm (Needle y)))
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>y
yy -> y -> Maybe (Needle y)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.y
cmy) NonEmpty (Needle x, Shade' y)
ps
              ψ :: ψ
ψ = LinearRegressionResult (Needle x) (Needle y) ψ -> ψ
forall x y m. LinearRegressionResult x y m -> m
linearFit_bestModel LinearRegressionResult (Needle x) (Needle y) ψ
regResult
              σψ :: Variance ψ
σψ = Norm ψ -> Variance ψ
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm (Norm ψ -> Variance ψ)
-> (Norm ψ -> Norm ψ) -> Norm ψ -> Variance ψ
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 LinearRegressionResult (Needle x) (Needle y) ψ -> Scalar ψ
forall x y m. LinearRegressionResult x y m -> Scalar m
linearFit_χν² LinearRegressionResult (Needle x) (Needle y) ψ
regResult of
                                     Scalar ψ
χν² | s
Scalar ψ
χν² s -> s -> Bool
forall a. Ord a => a -> a -> Bool
> s
0, s -> s
forall a. Fractional a => a -> a
recip s
Scalar ψ
χν² s -> s -> Bool
forall a. Ord a => a -> a -> Bool
> s
0
                                            -> Scalar ψ -> Norm ψ -> Norm ψ
forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm (s -> s
forall a. Fractional a => a -> a
recip (s -> s) -> s -> s
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s
1 s -> s -> s
forall a. Num a => a -> a -> a
+ s -> s
forall a. Floating a => a -> a
sqrt s
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 ψ)) )-}
                                          Norm ψ -> Norm ψ
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
                                (Norm ψ -> Variance ψ) -> Norm ψ -> Variance ψ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearRegressionResult (Needle x) (Needle y) ψ -> Norm ψ
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 = (Needle x -> ψ +> Needle y)
-> [(Needle x, (Needle y, Norm (Needle y)))]
-> LinearRegressionResult (Needle x) (Needle y) ψ
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 (LinearFunction s ψ (Needle y) -> LinearMap s ψ (Needle y)
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 (LinearFunction s ψ (Needle y) -> LinearMap s ψ (Needle y))
-> (Needle x -> LinearFunction s ψ (Needle y))
-> Needle x
-> LinearMap s ψ (Needle y)
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 -> LinearFunction s ψ (Needle y)
Needle x -> ψ -+> Needle y
fwdCalc) (NonEmpty (Needle x, (Needle y, Norm (Needle y)))
-> [(Needle x, (Needle y, Norm (Needle y)))]
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 :: QuadraticModel x y
-> (Shade' y,
    (Shade' (LocalLinear x y), Shade' (LocalBilinear x y)))
quadraticModel_derivatives (QuadraticModel Shade y
sh Shade (LocalLinear x y)
shð Shade (LocalBilinear x y)
shð²)
    | (PseudoAffineWitness SemimanifoldWitness y
SemimanifoldWitness)
                                     :: PseudoAffineWitness y <- PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness
    , DualSpaceWitness :: DualSpaceWitness (Needle x) <- DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
    , DualSpaceWitness :: DualSpaceWitness (Needle y) <- DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
             = (Shade y -> Shade' y
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade y
sh, ( Shade (LocalLinear x y) -> Shade' (LocalLinear x y)
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade (LocalLinear x y)
shð
                              , (LocalBilinear x y +> LocalBilinear x y)
-> Shade' (LocalBilinear x y) -> Shade' (LocalBilinear x y)
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
  (LinearMap
     (Scalar (Needle x)) (LocalBilinear x y) (LocalBilinear x y))
2Scalar
  (LinearMap
     (Scalar (Needle x)) (LocalBilinear x y) (LocalBilinear x y))
-> LinearMap
     (Scalar (Needle x)) (LocalBilinear x y) (LocalBilinear x y)
-> LinearMap
     (Scalar (Needle x)) (LocalBilinear x y) (LocalBilinear x y)
forall v. VectorSpace v => Scalar v -> v -> v
*^LinearMap
  (Scalar (Needle x)) (LocalBilinear x y) (LocalBilinear x y)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) (Shade' (LocalBilinear x y) -> Shade' (LocalBilinear x y))
-> Shade' (LocalBilinear x y) -> Shade' (LocalBilinear x y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (LocalBilinear x y) -> Shade' (LocalBilinear x y)
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade (LocalBilinear x 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 :: NonEmpty (Local x, Shade' y) -> QuadraticModel x y
estimateLocalHessian NonEmpty (Local x, Shade' y)
pts = NonEmpty (Needle x, Shade' y) -> QuadraticModel x y
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 (NonEmpty (Needle x, Shade' y) -> QuadraticModel x y)
-> NonEmpty (Needle x, Shade' y) -> QuadraticModel x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Local x -> Needle x)
-> (Local x, Shade' y) -> (Needle x, Shade' y)
forall (a :: * -> * -> *) b d c.
(Morphism a, ObjectPair a b d, ObjectPair a c d) =>
a b c -> a (b, d) (c, d)
first Local x -> Needle x
forall x. Local x -> Needle x
getLocalOffset ((Local x, Shade' y) -> (Needle x, Shade' y))
-> NonEmpty (Local x, Shade' y) -> NonEmpty (Needle x, Shade' y)
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 :: LocalDataPropPlan x (Shade' y) -> ㄇ x y
propagationCenteredModel LocalDataPropPlan x (Shade' y)
propPlan = case [(Needle x, Shade' y)] -> Maybe (ㄇ x y)
forall (ㄇ :: * -> * -> *) x y.
(LocalModel ㄇ, ModellableRelation x y) =>
[(Needle x, Shade' y)] -> Maybe (ㄇ x y)
fitLocally (NonEmpty (Needle x, Shade' y) -> [(Needle x, Shade' y)]
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)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
-> Needle x
forall s a. s -> Getting a s a -> a
^.Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffsetNeedle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
2
       ptsFromCenter :: NonEmpty (Needle x, Shade' y)
ptsFromCenter = (Needle x -> Needle x
forall v. AdditiveGroup v => v -> v
negateV Needle x
ctrOffset, LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
forall x y. Lens' (LocalDataPropPlan x y) y
sourceData)
                     (Needle x, Shade' y)
-> [(Needle x, Shade' y)] -> NonEmpty (Needle x, Shade' y)
forall a. a -> [a] -> NonEmpty a
:| [(Needle x
δxNeedle x -> Needle x -> Needle x
forall v. AdditiveGroup v => v -> v -> v
^-^Needle x
ctrOffset, Shade' y
shy)
                        | (Needle x
δx, Shade' y
shy)
                            <- (LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
-> Needle x
forall s a. s -> Getting a s a -> a
^.Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffset, LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
forall x y. Lens' (LocalDataPropPlan x y) y
targetAPrioriData)
                               (Needle x, Shade' y)
-> [(Needle x, Shade' y)] -> [(Needle x, Shade' y)]
forall a. a -> [a] -> [a]
: LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting
     [(Needle x, Shade' y)]
     (LocalDataPropPlan x (Shade' y))
     [(Needle x, Shade' y)]
-> [(Needle x, Shade' y)]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Needle x, Shade' y)]
  (LocalDataPropPlan x (Shade' y))
  [(Needle x, Shade' y)]
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 :: LocalDataPropPlan x (Shade' y) -> QuadraticModel x y
propagationCenteredQuadraticModel = LocalDataPropPlan x (Shade' y) -> QuadraticModel x y
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 :: 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 (DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x)
                          (DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness y)
                          (PseudoAffineWitness 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)
          | Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
Nothing <- Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
jacobian  = Maybe (Shade' y)
forall a. Maybe a
Nothing
          | Bool
otherwise            = Shade' y -> Maybe (Shade' y)
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 ℝ (Needle x) (Needle y)))
jacobian) = DifferentialEqn ㄇ x y
f Shade (x, y)
shxy LocalDifferentialEqn ㄇ x y
-> Getting
     (ㄇ x y
      -> (Maybe (Shade' y),
          Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))))
     (LocalDifferentialEqn ㄇ x y)
     (ㄇ x y
      -> (Maybe (Shade' y),
          Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))))
-> ㄇ x y
-> (Maybe (Shade' y),
    Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
forall s a. s -> Getting a s a -> a
^. Getting
  (ㄇ x y
   -> (Maybe (Shade' y),
       Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))))
  (LocalDifferentialEqn ㄇ x y)
  (ㄇ x y
   -> (Maybe (Shade' y),
       Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))))
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
                               (ㄇ x y
 -> (Maybe (Shade' y),
     Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))))
-> ㄇ x y
-> (Maybe (Shade' y),
    Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y))))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LocalDataPropPlan x (Shade' y) -> ㄇ x y
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 ℝ (Needle x) (Needle y))
jacobianSh = Shade' (LinearMap ℝ (Needle x) (Needle y))
-> Shade (LinearMap ℝ (Needle x) (Needle y))
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade' x -> Shade x
dualShade' (Shade' (LinearMap ℝ (Needle x) (Needle y))
 -> Shade (LinearMap ℝ (Needle x) (Needle y)))
-> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
-> Maybe (Shade (LinearMap ℝ (Needle x) (Needle y)))
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Maybe (Shade' (LinearMap ℝ (Needle x) (Needle y)))
jacobian
               mx :: x
mx = LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting x (LocalDataPropPlan x (Shade' y)) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (LocalDataPropPlan x (Shade' y)) x
forall x y. Lens' (LocalDataPropPlan x y) x
sourcePosition x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
-> Needle x
forall s a. s -> Getting a s a -> a
^.Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffset Needle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ ℝ
2 :: x
               (Shade x
_ Metric' x
expax' :: Shade x)
                    = x -> [Needle x] -> Shade x
forall x s.
(Fractional' s, WithField s PseudoAffine x,
 SimpleSpace (Needle x)) =>
x -> [Needle x] -> Shade x
coverAllAround (LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting x (LocalDataPropPlan x (Shade' y)) x -> x
forall s a. s -> Getting a s a -> a
^.Getting x (LocalDataPropPlan x (Shade' y)) x
forall x y. Lens' (LocalDataPropPlan x y) x
sourcePosition)
                                     [Needle x
δx | (Needle x
δx,Shade' y
_) <- LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting
     [(Needle x, Shade' y)]
     (LocalDataPropPlan x (Shade' y))
     [(Needle x, Shade' y)]
-> [(Needle x, Shade' y)]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Needle x, Shade' y)]
  (LocalDataPropPlan x (Shade' y))
  [(Needle x, Shade' y)]
forall x y. Lens' (LocalDataPropPlan x y) [(Needle x, y)]
relatedData]
               shxy :: Shade (x, y)
shxy = (x, y) -> [Needle (x, y)] -> Shade (x, y)
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 Needle x -> Needle x -> Needle x
forall v. AdditiveGroup v => v -> v -> v
^-^ LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
-> Needle x
forall s a. s -> Getting a s a -> a
^.Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
forall x y. Lens' (LocalDataPropPlan x y) (Needle x)
targetPosOffset Needle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ ℝ
2, Needle y
pυ Needle y -> Needle y -> Needle y
forall v. AdditiveGroup v => v -> v -> v
^+^ Needle y
v)
                                     | (Needle x
δx,Shade' y
neυ) <- (Needle x
forall v. AdditiveGroup v => v
zeroV, LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
forall x y. Lens' (LocalDataPropPlan x y) y
sourceData)
                                                  (Needle x, Shade' y)
-> [(Needle x, Shade' y)] -> [(Needle x, Shade' y)]
forall a. a -> [a] -> [a]
: ((Shade' y -> Shade' y)
-> (Needle x, Shade' y) -> (Needle x, Shade' y)
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second Shade' y -> Shade' y
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
                                                      ((Needle x, Shade' y) -> (Needle x, Shade' y))
-> [(Needle x, Shade' y)] -> [(Needle x, Shade' y)]
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)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting
     [(Needle x, Shade' y)]
     (LocalDataPropPlan x (Shade' y))
     [(Needle x, Shade' y)]
-> [(Needle x, Shade' y)]
forall s a. s -> Getting a s a -> a
^.Getting
  [(Needle x, Shade' y)]
  (LocalDataPropPlan x (Shade' y))
  [(Needle x, Shade' y)]
forall x y. Lens' (LocalDataPropPlan x y) [(Needle x, y)]
relatedData)
                                     , let Just Needle y
pυ = Shade' y
neυShade' y -> Getting y (Shade' y) y -> y
forall s a. s -> Getting a s a -> a
^.Getting y (Shade' y) y
forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr y -> y -> Maybe (Needle y)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. y
mυ
                                     , Needle y
v <- Seminorm (Needle y) -> [Needle y]
forall v.
(FiniteDimensional v, IEEE (Scalar v)) =>
Seminorm v -> [v]
normSpanningSystem' (Shade' y
neυShade' y
-> Getting (Seminorm (Needle y)) (Shade' y) (Seminorm (Needle y))
-> Seminorm (Needle y)
forall s a. s -> Getting a s a -> a
^.Getting (Seminorm (Needle y)) (Shade' y) (Seminorm (Needle y))
forall x. Lens' (Shade' x) (Metric x)
shadeNarrowness)
                                     ]
                where Just y
mυ = y -> y -> Maybe y
forall x. Geodesic x => x -> x -> Maybe x
middleBetween (LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting y (LocalDataPropPlan x (Shade' y)) y -> y
forall s a. s -> Getting a s a -> a
^.(Shade' y -> Const y (Shade' y))
-> LocalDataPropPlan x (Shade' y)
-> Const y (LocalDataPropPlan x (Shade' y))
forall x y. Lens' (LocalDataPropPlan x y) y
sourceData((Shade' y -> Const y (Shade' y))
 -> LocalDataPropPlan x (Shade' y)
 -> Const y (LocalDataPropPlan x (Shade' y)))
-> Getting y (Shade' y) y
-> Getting y (LocalDataPropPlan x (Shade' y)) y
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
.Getting y (Shade' y) y
forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr)
                                              (LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting y (LocalDataPropPlan x (Shade' y)) y -> y
forall s a. s -> Getting a s a -> a
^.(Shade' y -> Const y (Shade' y))
-> LocalDataPropPlan x (Shade' y)
-> Const y (LocalDataPropPlan x (Shade' y))
forall x y. Lens' (LocalDataPropPlan x y) y
targetAPrioriData((Shade' y -> Const y (Shade' y))
 -> LocalDataPropPlan x (Shade' y)
 -> Const y (LocalDataPropPlan x (Shade' y)))
-> Getting y (Shade' y) y
-> Getting y (LocalDataPropPlan x (Shade' y)) y
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
.Getting y (Shade' y) y
forall (shade :: * -> *) x. IsShade shade => Lens' (shade x) x
shadeCtr)
               expax :: Variance (DualVector (Needle x))
expax = Metric' x -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric' x
expax'
               result :: Shade' y
               result :: Shade' y
result = Shade' y -> Shade' (Needle y) -> Shade' y
forall y. Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
convolveShade' (LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
-> Shade' y
forall s a. s -> Getting a s a -> a
^.Getting (Shade' y) (LocalDataPropPlan x (Shade' y)) (Shade' y)
forall x y. Lens' (LocalDataPropPlan x y) y
sourceData)
                             (Shade (Needle y) -> Shade' (Needle y)
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade (Shade (Needle y) -> Shade' (Needle y))
-> (Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade (Needle y))
-> Shade (LinearMap ℝ (Needle x) (Needle y))
-> Shade' (Needle y)
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
. (LinearMap ℝ (Needle x) (Needle y) +> Needle y)
-> Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade (Needle y)
forall x y s.
(Num' s, LinearSpace x, SimpleSpace y, Scalar x ~ s,
 Scalar y ~ s) =>
(x +> y) -> Shade x -> Shade y
linearProjectShade ((LinearMap ℝ (Needle x) (Needle y) -> Needle y)
-> LinearMap ℝ (LinearMap ℝ (Needle x) (Needle y)) (Needle y)
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 (LinearMap ℝ (Needle x) (Needle y) -> Needle x -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx)) (Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade' (Needle y))
-> Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade' (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (LinearMap ℝ (Needle x) (Needle y))
Shade (LocalLinear x y)
jacobianSh)
               δx :: Needle x
δx = LocalDataPropPlan x (Shade' y)
propPlanLocalDataPropPlan x (Shade' y)
-> Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
-> Needle x
forall s a. s -> Getting a s a -> a
^.Getting (Needle x) (LocalDataPropPlan x (Shade' y)) (Needle x)
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ℝ -> Int
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
$ Int -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) Int -> Int -> Int
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 :: p v -> Int
p¹Dimension p v
_ = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d
 where d :: Int
d = SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis v
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 :: p v -> Int
p²Dimension p v
_ = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
*(Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1))Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div`Int
2
 where d :: Int
d = SubBasis v -> Int
forall v. FiniteDimensional v => SubBasis v -> Int
subbasisDimension (SubBasis v
forall v. FiniteDimensional v => SubBasis v
entireBasis :: SubBasis v)

instance LocalModel AffineModel where
  fitLocally :: [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
fitLocally = DualSpaceWitness (Needle y)
-> [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
forall x y.
ModellableRelation x y =>
DualSpaceWitness (Needle y)
-> [(Needle x, Shade' y)] -> Maybe (AffineModel x y)
aFitL DualSpaceWitness (Needle y)
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 :: 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)]
_) <- Int
-> [(Needle x, Shade' y)]
-> ([(Needle x, Shade' y)], [(Needle x, Shade' y)])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int -> Int
modelParametersOverdetMargin
                                        (Int -> Int) -> Int -> Int
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Needle x] -> Int
forall v (p :: * -> *). FiniteDimensional v => p v -> Int
p¹Dimension ([]::[Needle x])) [(Needle x, Shade' y)]
dataPts
                 = AffineModel x y -> Maybe (AffineModel x y)
forall a. a -> Maybe a
Just (AffineModel x y -> Maybe (AffineModel x y))
-> (NonEmpty (Needle x, Shade' y) -> AffineModel x y)
-> NonEmpty (Needle x, Shade' y)
-> Maybe (AffineModel x y)
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, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
    -+> Needle y)
-> (y
    -> (Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
    -> Variance
         (Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
    -> AffineModel x y)
-> NonEmpty (Needle x, Shade' y)
-> AffineModel x y
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 -> ((Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
 -> Needle y)
-> (Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
   -+> Needle y
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 (((Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
  -> Needle y)
 -> (Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
    -+> Needle y)
-> ((Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
    -> Needle y)
-> (Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
   -+> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(Needle y
b,LinearMap (Scalar (Needle x)) (Needle x) (Needle y)
a) -> (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)
a LinearMap (Scalar (Needle x)) (Needle x) (Needle y)
-> Needle x -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx) Needle y -> Needle y -> Needle y
forall v. AdditiveGroup v => v -> v -> v
^+^ Needle y
b )
                            (\y
cmy (Needle y
bBest, LinearMap (Scalar (Needle x)) (Needle x) (Needle y)
aBest) Variance
  (Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
σ
                               -> let (Norm (DualVector (Needle y))
σb, Norm (Tensor ℝ (Needle x) (DualVector (Needle y)))
σa) = Norm
  (DualVector (Needle y),
   Tensor ℝ (Needle x) (DualVector (Needle y)))
-> (Norm (DualVector (Needle y)),
    Norm (Tensor ℝ (Needle x) (DualVector (Needle y))))
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms Norm
  (DualVector (Needle y),
   Tensor ℝ (Needle x) (DualVector (Needle y)))
Variance
  (Needle y, LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
σ
                                  in Shade y
-> Shade (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
-> AffineModel x y
forall x y.
Shade y -> Shade (Needle x +> Needle y) -> AffineModel x y
AffineModel (y -> Norm (DualVector (Needle y)) -> Shade y
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (y
cmyy -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
bBest)
                                                        (Norm (DualVector (Needle y)) -> Shade y)
-> Norm (DualVector (Needle y)) -> Shade y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Scalar (DualVector (Needle y))
-> Norm (DualVector (Needle y)) -> Norm (DualVector (Needle y))
forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm Scalar (DualVector (Needle y))
2 Norm (DualVector (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.
                                                 (LinearMap (Scalar (Needle x)) (Needle x) (Needle y)
-> Metric' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
-> Shade (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade LinearMap (Scalar (Needle x)) (Needle x) (Needle y)
aBest Metric' (LinearMap (Scalar (Needle x)) (Needle x) (Needle y))
Norm (Tensor ℝ (Needle x) (DualVector (Needle y)))
σa) )
                     (NonEmpty (Needle x, Shade' y) -> Maybe (AffineModel x y))
-> NonEmpty (Needle x, Shade' y) -> Maybe (AffineModel x y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((Needle x, Shade' y)
p₀(Needle x, Shade' y)
-> [(Needle x, Shade' y)] -> NonEmpty (Needle x, Shade' y)
forall a. a -> [a] -> NonEmpty a
:|[(Needle x, Shade' y)]
ps[(Needle x, Shade' y)]
-> [(Needle x, Shade' y)] -> [(Needle x, Shade' y)]
forall a. [a] -> [a] -> [a]
++[(Needle x, Shade' y)
pω])
          | Bool
otherwise  = Maybe (AffineModel x y)
forall a. Maybe a
Nothing
  tweakLocalOffset :: Lens' (AffineModel x y) (Shade y)
tweakLocalOffset = (Shade y -> f (Shade y)) -> AffineModel x y -> f (AffineModel x y)
forall x y. Lens' (AffineModel x y) (Shade y)
affineModelOffset
  evalLocalModel :: AffineModel x y -> Needle x -> Shade' y
evalLocalModel = PseudoAffineWitness y -> AffineModel x y -> Needle x -> Shade' y
forall x y.
ModellableRelation x y =>
PseudoAffineWitness y -> AffineModel x y -> Needle x -> Shade' y
aEvL PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness
   where aEvL :: ∀ x y . ModellableRelation x y
                => PseudoAffineWitness y -> AffineModel x y -> Needle x -> Shade' y
         aEvL :: 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
          = Shade' y -> Shade' (Needle y) -> Shade' y
forall y. Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
convolveShade' (Shade y -> Shade' y
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade Shade y
shy₀)
                           (Shade (Needle y) -> Shade' (Needle y)
forall x.
(PseudoAffine x, SimpleSpace (Needle x)) =>
Shade x -> Shade' x
dualShade (Shade (Needle y) -> Shade' (Needle y))
-> (Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade (Needle y))
-> Shade (LinearMap ℝ (Needle x) (Needle y))
-> Shade' (Needle y)
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
. (LinearMap ℝ (Needle x) (Needle y) +> Needle y)
-> Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade (Needle y)
forall x y s.
(Num' s, LinearSpace x, SimpleSpace y, Scalar x ~ s,
 Scalar y ~ s) =>
(x +> y) -> Shade x -> Shade y
linearProjectShade ((LinearMap ℝ (Needle x) (Needle y) -> Needle y)
-> LinearMap ℝ (LinearMap ℝ (Needle x) (Needle y)) (Needle y)
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 (LinearMap ℝ (Needle x) (Needle y) -> Needle x -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
δx)) (Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade' (Needle y))
-> Shade (LinearMap ℝ (Needle x) (Needle y)) -> Shade' (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Shade (LinearMap ℝ (Needle x) (Needle y))
Shade (Needle x +> Needle y)
shj)

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