-- |
-- Module      : Data.Function.Differentiable
-- Copyright   : (c) Justus Sagemüller 2015
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 

{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE UndecidableInstances     #-}
{-# LANGUAGE TypeFamilies             #-}
{-# LANGUAGE FunctionalDependencies   #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE LiberalTypeSynonyms      #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE RankNTypes               #-}
{-# LANGUAGE TupleSections            #-}
{-# LANGUAGE ConstraintKinds          #-}
{-# LANGUAGE PatternGuards            #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE TypeApplications         #-}
{-# LANGUAGE UnicodeSyntax            #-}
{-# LANGUAGE MultiWayIf               #-}
{-# LANGUAGE LambdaCase               #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE RecordWildCards          #-}
{-# LANGUAGE CPP                      #-}


module Data.Function.Differentiable (
            -- * Everywhere differentiable functions
              Differentiable
            -- * Region-wise defined diff'able functions
            , RWDiffable
            -- ** Operators for piecewise definition
            -- $definitionRegionOps
            , (?->), (?>), (?<), (?|:), backupRegions
            -- * Regions within a manifold
            , Region
            , smoothIndicator
            -- * Evaluation of differentiable functions
            , discretisePathIn
            , discretisePathSegs
            , continuityRanges
            , regionOfContinuityAround
            , analyseLocalBehaviour
            , intervalImages
            ) where
    


import Data.List
import Data.Maybe
import Data.Semigroup
import Data.Embedding
import Data.MemoTrie (HasTrie)

import Data.VectorSpace
import Math.LinearMap.Category
import Data.AffineSpace
import Data.Function.Differentiable.Data
import Data.Function.Affine
import Data.Basis
import Data.Tagged
import Data.Manifold.Types.Primitive
import Data.Manifold.PseudoAffine
import Data.Manifold.WithBoundary
import Data.Manifold.WithBoundary.Class
import Data.Manifold.Atlas

import qualified Prelude
import qualified Control.Applicative as Hask

import Control.Category.Constrained.Prelude hiding ((^))
import Control.Arrow.Constrained
import Control.Monad.Constrained
import Data.Foldable.Constrained



type RealDimension s
       = ( RealFloat' s, Manifold s, SimpleSpace s, Atlas' s
         , s ~ Needle s, s ~ Scalar s, s ~ DualVector s )


discretisePathIn :: (WithField ℝ Manifold y, SimpleSpace (Needle y))
      => Int                        -- ^ Limit the number of steps taken in either direction. Note this will not cap the resolution but /length/ of the discretised path.
      -> ℝInterval                  -- ^ Parameter interval of interest.
      -> (RieMetric ℝ, RieMetric y) -- ^ Inaccuracy allowance /ε/.
      -> (Differentiable ℝ ℝ y)     -- ^ Path specification.
      -> [(ℝ,y)]                    -- ^ Trail of points along the path, such that a linear interpolation deviates nowhere by more as /ε/.
discretisePathIn :: forall y.
(WithField ℝ Manifold y, SimpleSpace (Needle y)) =>
Int
-> (ℝ, ℝ)
-> (RieMetric ℝ, RieMetric y)
-> Differentiable ℝ ℝ y
-> [(ℝ, y)]
discretisePathIn Int
nLim (ℝ
xl, ℝ
xr) (RieMetric ℝ
mx,RieMetric y
my) (Differentiable ℝ -> (y, Needle ℝ +> Needle y, LinDevPropag ℝ y)
f)
         = forall a. [a] -> [a]
reverse (forall a. [a] -> [a]
tail 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 a. Int -> [a] -> [a]
take Int
nLim forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> [(ℝ, y)]
traceFwd ℝ
xl ℝ
xm (-ℝ
1))
          forall a. [a] -> [a] -> [a]
++ forall a. Int -> [a] -> [a]
take Int
nLim (ℝ -> ℝ -> ℝ -> [(ℝ, y)]
traceFwd ℝ
xr ℝ
xm ℝ
1)
 where traceFwd :: ℝ -> ℝ -> ℝ -> [(ℝ, y)]
traceFwd ℝ
xlim ℝ
x₀ ℝ
dir
         | forall a. Num a => a -> a
signum (ℝ
x₀forall a. Num a => a -> a -> a
-ℝ
xlim) forall a. Eq a => a -> a -> Bool
== forall a. Num a => a -> a
signum ℝ
dir = [(ℝ
xlim, y
fxlim)]
         | Bool
otherwise                      = (ℝ
x₀, y
fx₀) forall a. a -> [a] -> [a]
: ℝ -> ℝ -> ℝ -> [(ℝ, y)]
traceFwd ℝ
xlim (ℝ
x₀forall a. Num a => a -> a -> a
+ℝ
xstep) ℝ
dir
        where (y
fx₀, Needle ℝ +> Needle y
jf, LinDevPropag ℝ y
δx²) = ℝ -> (y, Needle ℝ +> Needle y, LinDevPropag ℝ y)
f ℝ
x₀
              εx :: Norm (Needle y)
εx = RieMetric y
my y
fx₀ forall v. SimpleSpace v => Norm v -> [v] -> Norm v
`relaxNorm` [Needle ℝ +> Needle y
jf forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s. RealFrac' s => Norm s -> s
normalLength forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ RieMetric ℝ
mx ℝ
x₀]
              χ :: Scalar ℝ
χ = LinDevPropag ℝ y
δx² Norm (Needle y)
εx forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| ℝ
1
              xstep :: ℝ
xstep = ℝ
dir forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
min (forall a. Num a => a -> a
abs ℝ
x₀forall a. Num a => a -> a -> a
+ℝ
1) (forall a. Fractional a => a -> a
recip Scalar ℝ
χ)
              (y
fxlim, Needle ℝ +> Needle y
_, LinDevPropag ℝ y
_) = ℝ -> (y, Needle ℝ +> Needle y, LinDevPropag ℝ y)
f ℝ
xlim
       xm :: ℝ
xm = (ℝ
xr forall a. Num a => a -> a -> a
+ ℝ
xl) forall a. Fractional a => a -> a -> a
/ ℝ
2
                      
type ℝInterval = (ℝ,ℝ)

continuityRanges :: WithField ℝ Manifold y
      => Int                        -- ^ Max number of exploration steps per region
      -> RieMetric ℝ                -- ^ Needed resolution of boundaries
      -> RWDiffable ℝ ℝ y           -- ^ Function to investigate
      -> ([ℝInterval], [ℝInterval]) -- ^ Subintervals on which the function is guaranteed continuous.
continuityRanges :: forall y.
WithField ℝ Manifold y =>
Int -> RieMetric ℝ -> RWDiffable ℝ ℝ y -> ([(ℝ, ℝ)], [(ℝ, ℝ)])
continuityRanges Int
nLim RieMetric ℝ
δbf (RWDiffable ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ y))
f)
  | (PreRegion ℝ ℝ
GlobalRegion, Maybe (Differentiable ℝ ℝ y)
_) <- ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ y))
f ℝ
xc
                 = ([], [(-ℝ
huge,ℝ
huge)])
  | Bool
otherwise    = forall {a} {b}.
Eq a =>
[(a, a)] -> [(a, b)] -> ([(a, a)], [(a, b)])
glueMid (ℝ -> ℝ -> [(ℝ, ℝ)]
go ℝ
xc (-ℝ
1)) (ℝ -> ℝ -> [(ℝ, ℝ)]
go ℝ
xc ℝ
1)
 where go :: ℝ -> ℝ -> [(ℝ, ℝ)]
go ℝ
x₀ ℝ
dir
         | ℝ
yq₀ forall a. Ord a => a -> a -> Bool
<= forall a. Num a => a -> a
abs ((Needle ℝ +> Needle ℝ
jq₀forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ℝ
1) forall a. Num a => a -> a -> a
* ℝ
step₀)
                      = ℝ -> ℝ -> [(ℝ, ℝ)]
go (ℝ
x₀ forall a. Num a => a -> a -> a
+ ℝ
step₀forall a. Fractional a => a -> a -> a
/ℝ
2) ℝ
dir
         | RealSubray S⁰_ ℝ
PositiveHalfSphere ℝ
xl' <- PreRegion ℝ ℝ
rangeHere
                      = let stepl' :: ℝ
stepl' = ℝ
dirforall a. Fractional a => a -> a -> a
/(RieMetric ℝ
δbf ℝ
xl'forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| ℝ
2)
                        in if ℝ
dirforall a. Ord a => a -> a -> Bool
>ℝ
0
                            then if Bool
definedHere then [(forall a. Ord a => a -> a -> a
max (ℝ
xl'forall a. Num a => a -> a -> a
+ℝ
stepl') ℝ
x₀, ℝ
huge)]
                                                else []
                            else if Bool
definedHere Bool -> Bool -> Bool
&& ℝ
x₀ forall a. Ord a => a -> a -> Bool
> ℝ
xl'forall a. Num a => a -> a -> a
+ℝ
stepl'
                                  then (ℝ
xl'forall a. Num a => a -> a -> a
+ℝ
stepl',ℝ
x₀) forall a. a -> [a] -> [a]
: ℝ -> ℝ -> [(ℝ, ℝ)]
go (ℝ
xl'forall a. Num a => a -> a -> a
-ℝ
stepl') ℝ
dir
                                  else ℝ -> ℝ -> [(ℝ, ℝ)]
go (ℝ
xl'forall a. Num a => a -> a -> a
-ℝ
stepl') ℝ
dir
         | RealSubray S⁰_ ℝ
NegativeHalfSphere ℝ
xr' <- PreRegion ℝ ℝ
rangeHere
                      = let stepr' :: ℝ
stepr' = ℝ
dirforall a. Fractional a => a -> a -> a
/(RieMetric ℝ
δbf ℝ
xr'forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| ℝ
2)
                        in if ℝ
dirforall a. Ord a => a -> a -> Bool
<ℝ
0
                            then if Bool
definedHere then [(-ℝ
huge, forall a. Ord a => a -> a -> a
min (ℝ
xr'forall a. Num a => a -> a -> a
-ℝ
stepr') ℝ
x₀)]
                                                else []
                            else if Bool
definedHere Bool -> Bool -> Bool
&& ℝ
x₀ forall a. Ord a => a -> a -> Bool
< ℝ
xr'forall a. Num a => a -> a -> a
-ℝ
stepr'
                                  then (ℝ
x₀,ℝ
xr'forall a. Num a => a -> a -> a
-ℝ
stepr') forall a. a -> [a] -> [a]
: ℝ -> ℝ -> [(ℝ, ℝ)]
go (ℝ
xr'forall a. Num a => a -> a -> a
+ℝ
stepr') ℝ
dir
                                  else ℝ -> ℝ -> [(ℝ, ℝ)]
go (ℝ
xr'forall a. Num a => a -> a -> a
+ℝ
stepr') ℝ
dir
         | Bool
otherwise  = Int -> ℝ -> ℝ -> [(ℝ, ℝ)]
exit Int
nLim ℝ
dir ℝ
x₀
        where (PreRegion ℝ ℝ
rangeHere, Maybe (Differentiable ℝ ℝ y)
fq₀) = ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ y))
f ℝ
x₀
              (PreRegion (Differentiable ℝ -> (ℝ, Needle ℝ +> Needle ℝ, LinDevPropag ℝ ℝ)
r₀)) = forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion ℝ ℝ
rangeHere
              (ℝ
yq₀, Needle ℝ +> Needle ℝ
jq₀, LinDevPropag ℝ ℝ
δyq₀) = ℝ -> (ℝ, Needle ℝ +> Needle ℝ, LinDevPropag ℝ ℝ)
r₀ ℝ
x₀
              step₀ :: ℝ
step₀ = ℝ
dirforall a. Fractional a => a -> a -> a
/(RieMetric ℝ
δbf ℝ
x₀forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| ℝ
1)
              exit :: Int -> ℝ -> ℝ -> [(ℝ, ℝ)]
exit Int
0 ℝ
_ ℝ
xq
                | Bool -> Bool
not Bool
definedHere  = []
                | ℝ
xq forall a. Ord a => a -> a -> Bool
< ℝ
xc          = [(ℝ
xq,ℝ
x₀)]
                | Bool
otherwise        = [(ℝ
x₀,ℝ
xq)]
              exit Int
nLim' ℝ
dir' ℝ
xq
                | ℝ
yq₁forall a. Ord a => a -> a -> Bool
<ℝ
0 Bool -> Bool -> Bool
|| forall a. RealDimension a => LinDevPropag a a -> a -> a
as_devεδ LinDevPropag ℝ ℝ
δyq ℝ
yq₁forall a. Ord a => a -> a -> Bool
<forall a. Num a => a -> a
abs ℝ
stepp
                                      = Int -> ℝ -> ℝ -> [(ℝ, ℝ)]
exit (Int
nLim'forall a. Num a => a -> a -> a
-Int
1) (ℝ
dir'forall a. Fractional a => a -> a -> a
/ℝ
2) ℝ
xq
                | ℝ
yq₂forall a. Ord a => a -> a -> Bool
<ℝ
0
                , forall a. RealDimension a => LinDevPropag a a -> a -> a
as_devεδ LinDevPropag ℝ ℝ
δyq (-ℝ
yq₂)forall a. Ord a => a -> a -> Bool
>=forall a. Num a => a -> a
abs ℝ
stepp
                , ℝ -> ℝ
resoHere ℝ
steppforall a. Ord a => a -> a -> Bool
<ℝ
1    = (if Bool
definedHere
                                          then ((forall a. Ord a => a -> a -> a
min ℝ
x₀ ℝ
xq₁, forall a. Ord a => a -> a -> a
max ℝ
x₀ ℝ
xq₁)forall a. a -> [a] -> [a]
:)
                                          else 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
$ ℝ -> ℝ -> [(ℝ, ℝ)]
go ℝ
xq₂ ℝ
dir
                | Bool
otherwise           = Int -> ℝ -> ℝ -> [(ℝ, ℝ)]
exit (Int
nLim'forall a. Num a => a -> a -> a
-Int
1) ℝ
dir ℝ
xq₁
               where (ℝ
yq, Needle ℝ +> Needle ℝ
jq, LinDevPropag ℝ ℝ
δyq) = ℝ -> (ℝ, Needle ℝ +> Needle ℝ, LinDevPropag ℝ ℝ)
r₀ ℝ
xq
                     xq₁ :: ℝ
xq₁ = ℝ
xq forall a. Num a => a -> a -> a
+ ℝ
stepp
                     xq₂ :: ℝ
xq₂ = ℝ
xq₁ forall a. Num a => a -> a -> a
+ ℝ
stepp
                     yq₁ :: ℝ
yq₁ = ℝ
yq forall a. Num a => a -> a -> a
+ ℝ
f'xforall a. Num a => a -> a -> a
*ℝ
stepp
                     yq₂ :: ℝ
yq₂ = ℝ
yq₁ forall a. Num a => a -> a -> a
+ ℝ
f'xforall a. Num a => a -> a -> a
*ℝ
stepp
                     f'x :: ℝ
f'x = Needle ℝ +> Needle ℝ
jq forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ
1
                     stepp :: ℝ
stepp | ℝ
f'xforall a. Num a => a -> a -> a
*ℝ
dir forall a. Ord a => a -> a -> Bool
< ℝ
0  = -ℝ
0.9 forall a. Num a => a -> a -> a
* forall a. Num a => a -> a
abs ℝ
dir' forall a. Num a => a -> a -> a
* ℝ
yqforall a. Fractional a => a -> a -> a
/ℝ
f'x
                           | Bool
otherwise    = ℝ
dir' forall a. Num a => a -> a -> a
* forall a. RealDimension a => LinDevPropag a a -> a -> a
as_devεδ LinDevPropag ℝ ℝ
δyq ℝ
yq -- TODO: memoise in `exit` recursion
                     resoHere :: ℝ -> ℝ
resoHere = forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ RieMetric ℝ
δbf ℝ
xq
                     resoStep :: ℝ
resoStep = ℝ
dirforall a. Fractional a => a -> a -> a
/forall a. Floating a => a -> a
sqrt(ℝ -> ℝ
resoHere ℝ
1)
              definedHere :: Bool
definedHere = case Maybe (Differentiable ℝ ℝ y)
fq₀ of
                              Just Differentiable ℝ ℝ y
_  -> Bool
True
                              Maybe (Differentiable ℝ ℝ y)
Nothing -> Bool
False
       glueMid :: [(a, a)] -> [(a, b)] -> ([(a, a)], [(a, b)])
glueMid ((a
l,a
le):[(a, a)]
ls) ((a
re,b
r):[(a, b)]
rs) | a
leforall a. Eq a => a -> a -> Bool
==a
re  = ([(a, a)]
ls, (a
l,b
r)forall a. a -> [a] -> [a]
:[(a, b)]
rs)
       glueMid [(a, a)]
l [(a, b)]
r = ([(a, a)]
l,[(a, b)]
r)
       huge :: ℝ
huge = forall a. Floating a => a -> a
exp 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
nLim
       xc :: ℝ
xc = ℝ
0

discretisePathSegs :: (WithField ℝ Manifold y, SimpleSpace (Needle y))
      => Int              -- ^ Maximum number of path segments and/or points per segment.
      -> ( RieMetric ℝ
         , RieMetric y )  -- ^ Inaccuracy allowance /δ/ for arguments
                          --   (mostly relevant for resolution of discontinuity boundaries –
                          --   consider it a “safety margin from singularities”),
                          --   and /ε/ for results in the target space.
      -> RWDiffable ℝ ℝ y -- ^ Path specification. It is recommended that this
                          --   function be limited to a compact interval (e.g. with
                          --   '?>', '?<' and '?->'). For many functions the discretisation
                          --   will even work on an infinite interval: the point density
                          --   is exponentially decreased towards the infinities. But
                          --   this is still pretty bad for performance.
      -> ([[(ℝ,y)]], [[(ℝ,y)]]) -- ^ Discretised paths: continuous segments in either direction
discretisePathSegs :: forall y.
(WithField ℝ Manifold y, SimpleSpace (Needle y)) =>
Int
-> (RieMetric ℝ, RieMetric y)
-> RWDiffable ℝ ℝ y
-> ([[(ℝ, y)]], [[(ℝ, y)]])
discretisePathSegs Int
nLim (RieMetric ℝ
mx,RieMetric y
my) f :: RWDiffable ℝ ℝ y
f@(RWDiffable ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ y))
ff)
                            = ( forall a b. (a -> b) -> [a] -> [b]
map (ℝ, ℝ) -> [(ℝ, y)]
discretise [(ℝ, ℝ)]
ivsL, forall a b. (a -> b) -> [a] -> [b]
map (ℝ, ℝ) -> [(ℝ, y)]
discretise [(ℝ, ℝ)]
ivsR )
 where ([(ℝ, ℝ)]
ivsL, [(ℝ, ℝ)]
ivsR) = forall y.
WithField ℝ Manifold y =>
Int -> RieMetric ℝ -> RWDiffable ℝ ℝ y -> ([(ℝ, ℝ)], [(ℝ, ℝ)])
continuityRanges Int
nLim RieMetric ℝ
mx RWDiffable ℝ ℝ y
f
       discretise :: (ℝ, ℝ) -> [(ℝ, y)]
discretise rng :: (ℝ, ℝ)
rng@(ℝ
l,ℝ
r) = forall y.
(WithField ℝ Manifold y, SimpleSpace (Needle y)) =>
Int
-> (ℝ, ℝ)
-> (RieMetric ℝ, RieMetric y)
-> Differentiable ℝ ℝ y
-> [(ℝ, y)]
discretisePathIn Int
nLim (ℝ, ℝ)
rng (RieMetric ℝ
mx,RieMetric y
my) Differentiable ℝ ℝ y
fr
        where (PreRegion ℝ ℝ
_, Just Differentiable ℝ ℝ y
fr) = ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ y))
ff forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ
lforall a. Num a => a -> a -> a
+ℝ
r)forall a. Fractional a => a -> a -> a
/ℝ
2

              
analyseLocalBehaviour ::
     RWDiffable ℝ ℝ ℝ
  -> ℝ                      -- ^ /x/₀ value.
  -> Maybe ( (ℝ,ℝ)
           , ℝ->Maybe ℝ ) -- ^ /f/ /x/₀, derivative (i.e. Taylor-1-coefficient),
                           --   and reverse propagation of /O/ (/δ/²) bound.
analyseLocalBehaviour :: RWDiffable ℝ ℝ ℝ -> ℝ -> Maybe ((ℝ, ℝ), ℝ -> Maybe ℝ)
analyseLocalBehaviour (RWDiffable ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ ℝ))
f) ℝ
x₀ = case ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ ℝ))
f ℝ
x₀ of
       (PreRegion ℝ ℝ
r, Just (Differentiable ℝ -> (ℝ, Needle ℝ +> Needle ℝ, LinDevPropag ℝ ℝ)
fd))
           | forall {a} {m}. (Ord a, Num a) => PreRegion a m -> m -> Bool
inRegion PreRegion ℝ ℝ
r ℝ
x₀ -> 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
$
              let (ℝ
fx, Needle ℝ +> Needle ℝ
j, LinDevPropag ℝ ℝ
δf) = ℝ -> (ℝ, Needle ℝ +> Needle ℝ, LinDevPropag ℝ ℝ)
fd ℝ
x₀
                  epsprop :: ℝ -> Maybe ℝ
epsprop ℝ
ε
                    | ℝ
εforall a. Ord a => a -> a -> Bool
>ℝ
0  = case (LinDevPropag ℝ ℝ
δf forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [forall a. Fractional a => a -> a
recip ℝ
ε])forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| ℝ
1 of
                               Scalar ℝ
0  -> forall (f :: * -> *) a. Alternative f => f a
empty
                               Scalar ℝ
δ' -> 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 a. Fractional a => a -> a
recip Scalar ℝ
δ'
                    | Bool
otherwise  = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure ℝ
0
              in ((ℝ
fx, Needle ℝ +> Needle ℝ
j forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ
1), ℝ -> Maybe ℝ
epsprop)
       (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ ℝ))
_ -> forall (f :: * -> *) a. Alternative f => f a
empty
 where                                    -- This check shouldn't really be necessary,
                                          -- because the initial value lies by definition
       inRegion :: PreRegion a m -> m -> Bool
inRegion PreRegion a m
GlobalRegion m
_ = Bool
True     -- in its domain.
       inRegion (PreRegion (Differentiable m -> (a, Needle m +> Needle a, LinDevPropag m a)
rf)) m
x
         | (a
yr,Needle m +> Needle a
_,LinDevPropag m a
_) <- m -> (a, Needle m +> Needle a, LinDevPropag m a)
rf m
x   = a
yrforall a. Ord a => a -> a -> Bool
>a
0
       inRegion (RealSubray S⁰_ ℝ
PositiveHalfSphere a
xl) m
x = m
xforall a. Ord a => a -> a -> Bool
>a
xl
       inRegion (RealSubray S⁰_ ℝ
NegativeHalfSphere a
xr) m
x = m
xforall a. Ord a => a -> a -> Bool
<a
xr

-- | Represent a 'Region' by a smooth function which is positive within the region,
--   and crosses zero at the boundary.
smoothIndicator :: (LocallyScalable ℝ q, Manifold q, Atlas' q, SimpleSpace (Needle q))
                       => Region ℝ q -> Differentiable ℝ q ℝ
smoothIndicator :: forall q.
(LocallyScalable ℝ q, Manifold q, Atlas' q,
 SimpleSpace (Needle q)) =>
Region ℝ q -> Differentiable ℝ q ℝ
smoothIndicator (Region q
_ PreRegion ℝ q
r₀) = let (PreRegion Differentiable ℝ q ℝ
r) = forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion ℝ q
r₀
                                in  Differentiable ℝ q ℝ
r

regionOfContinuityAround :: RWDiffable ℝ q x -> q -> Region ℝ q
regionOfContinuityAround :: forall q x. RWDiffable ℝ q x -> q -> Region ℝ q
regionOfContinuityAround (RWDiffable q -> (PreRegion ℝ q, Maybe (Differentiable ℝ q x))
f) q
q = forall s m. m -> PreRegion s m -> Region s m
Region q
q 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 (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst 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
. q -> (PreRegion ℝ q, Maybe (Differentiable ℝ q x))
f forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ q
q
              

intervalImages ::
         Int                         -- ^ Max number of exploration steps per region
      -> (RieMetric ℝ, RieMetric ℝ)  -- ^ Needed resolution in (x,y) direction
      -> RWDiffable ℝ ℝ ℝ            -- ^ Function to investigate
      -> ( [(ℝInterval,ℝInterval)]
         , [(ℝInterval,ℝInterval)] ) -- ^ (XInterval, YInterval) rectangles in which
                                     --   the function graph lies.
intervalImages :: Int
-> (RieMetric ℝ, RieMetric ℝ)
-> RWDiffable ℝ ℝ ℝ
-> ([((ℝ, ℝ), (ℝ, ℝ))], [((ℝ, ℝ), (ℝ, ℝ))])
intervalImages Int
nLim (RieMetric ℝ
mx,RieMetric ℝ
my) f :: RWDiffable ℝ ℝ ℝ
f@(RWDiffable ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ ℝ))
fd)
                  = (forall a b. (a -> b) -> [a] -> [b]
map (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&(ℝ, ℝ) -> (ℝ, ℝ)
ivimg) [(ℝ, ℝ)]
domsL, forall a b. (a -> b) -> [a] -> [b]
map (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&(ℝ, ℝ) -> (ℝ, ℝ)
ivimg) [(ℝ, ℝ)]
domsR)
 where ([(ℝ, ℝ)]
domsL, [(ℝ, ℝ)]
domsR) = forall y.
WithField ℝ Manifold y =>
Int -> RieMetric ℝ -> RWDiffable ℝ ℝ y -> ([(ℝ, ℝ)], [(ℝ, ℝ)])
continuityRanges Int
nLim RieMetric ℝ
mx RWDiffable ℝ ℝ ℝ
f
       ivimg :: (ℝ, ℝ) -> (ℝ, ℝ)
ivimg (ℝ
xl,ℝ
xr) = ℝ -> ℝ -> (ℝ, ℝ) -> (ℝ, ℝ)
go ℝ
xl ℝ
1 (ℝ, ℝ)
i₀ forall {a} {b}. (Ord a, Ord b) => (a, b) -> (a, b) -> (a, b)
∪ ℝ -> ℝ -> (ℝ, ℝ) -> (ℝ, ℝ)
go ℝ
xr (-ℝ
1) (ℝ, ℝ)
i₀
        where (PreRegion ℝ ℝ
_, Just fdd :: Differentiable ℝ ℝ ℝ
fdd@(Differentiable ℝ -> (ℝ, Needle ℝ +> Needle ℝ, LinDevPropag ℝ ℝ)
fddd))
                    = 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 (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> (PreRegion ℝ ℝ, Maybe (Differentiable ℝ ℝ ℝ))
fd ℝ
xc
              xc :: ℝ
xc = (ℝ
xlforall a. Num a => a -> a -> a
+ℝ
xr)forall a. Fractional a => a -> a -> a
/ℝ
2
              i₀ :: (ℝ, ℝ)
i₀ = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimumforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Differentiable ℝ ℝ ℝ
fddforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ℝ
xl, Differentiable ℝ ℝ ℝ
fddforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ℝ
xc, Differentiable ℝ ℝ ℝ
fddforall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ℝ
xr]
              go :: ℝ -> ℝ -> (ℝ, ℝ) -> (ℝ, ℝ)
go ℝ
x ℝ
dir (ℝ
a,ℝ
b)
                 | ℝ
dirforall a. Ord a => a -> a -> Bool
>ℝ
0 Bool -> Bool -> Bool
&& ℝ
xforall a. Ord a => a -> a -> Bool
>ℝ
xc   = (ℝ
a,ℝ
b)
                 | ℝ
dirforall a. Ord a => a -> a -> Bool
<ℝ
0 Bool -> Bool -> Bool
&& ℝ
xforall a. Ord a => a -> a -> Bool
<ℝ
xc   = (ℝ
a,ℝ
b)
                 | Scalar ℝ
χ forall a. Eq a => a -> a -> Bool
== ℝ
0          = (ℝ
y forall a. Num a => a -> a -> a
+ (ℝ
xforall a. Num a => a -> a -> a
-ℝ
xl)forall a. Num a => a -> a -> a
*ℝ
y', ℝ
y forall a. Num a => a -> a -> a
+ (ℝ
xforall a. Num a => a -> a -> a
-ℝ
xr)forall a. Num a => a -> a -> a
*ℝ
y')
                 | ℝ
y forall a. Ord a => a -> a -> Bool
< ℝ
aforall a. Num a => a -> a -> a
+ℝ
resoHere  = ℝ -> ℝ -> (ℝ, ℝ) -> (ℝ, ℝ)
go (ℝ
x forall a. Num a => a -> a -> a
+ ℝ
dirforall a. Fractional a => a -> a -> a
/Scalar ℝ
χ) ℝ
dir (ℝ
y,ℝ
b)
                 | ℝ
y forall a. Ord a => a -> a -> Bool
> ℝ
bforall a. Num a => a -> a -> a
-ℝ
resoHere  = ℝ -> ℝ -> (ℝ, ℝ) -> (ℝ, ℝ)
go (ℝ
x forall a. Num a => a -> a -> a
+ ℝ
dirforall a. Fractional a => a -> a -> a
/Scalar ℝ
χ) ℝ
dir (ℝ
a,ℝ
y)
                 | Bool
otherwise       = ℝ -> ℝ -> (ℝ, ℝ) -> (ℝ, ℝ)
go (ℝ
x forall a. Num a => a -> a -> a
+ ℝ -> ℝ
safeStep ℝ
stepOut₀) ℝ
dir (ℝ
a,ℝ
b)
               where (ℝ
y, Needle ℝ +> Needle ℝ
j, LinDevPropag ℝ ℝ
δε) = ℝ -> (ℝ, Needle ℝ +> Needle ℝ, LinDevPropag ℝ ℝ)
fddd ℝ
x
                     y' :: ℝ
y' = Needle ℝ +> Needle ℝ
j forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ
1
                     εx :: Metric ℝ
εx = RieMetric ℝ
my ℝ
y
                     resoHere :: ℝ
resoHere = forall s. RealFrac' s => Norm s -> s
normalLength Metric ℝ
εx
                     χ :: Scalar ℝ
χ = LinDevPropag ℝ ℝ
δε Metric ℝ
εxforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$| ℝ
1
                     safeStep :: ℝ -> ℝ
safeStep ℝ
s₀
                         | forall a. RealDimension a => LinDevPropag a a -> a -> a
as_devεδ LinDevPropag ℝ ℝ
δε (ℝ -> ℝ
safetyMarg ℝ
s₀) forall a. Ord a => a -> a -> Bool
> forall a. Num a => a -> a
abs ℝ
s₀  = ℝ
s₀
                         | Bool
otherwise                             = ℝ -> ℝ
safeStep (ℝ
s₀forall a. Num a => a -> a -> a
*ℝ
0.5)
                     stepOut₀ :: ℝ
stepOut₀ | ℝ
y'forall a. Num a => a -> a -> a
*ℝ
dirforall a. Ord a => a -> a -> Bool
>ℝ
0   = ℝ
0.5 forall a. Num a => a -> a -> a
* (ℝ
bforall a. Num a => a -> a -> a
-ℝ
y)forall a. Fractional a => a -> a -> a
/ℝ
y'
                              | Bool
otherwise  = -ℝ
0.5 forall a. Num a => a -> a -> a
* (ℝ
yforall a. Num a => a -> a -> a
-ℝ
a)forall a. Fractional a => a -> a -> a
/ℝ
y'
                     safetyMarg :: ℝ -> ℝ
safetyMarg ℝ
stp = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ℝ
yforall a. Num a => a -> a -> a
-ℝ
a, ℝ
yforall a. Num a => a -> a -> a
+ℝ
stpforall a. Num a => a -> a -> a
*ℝ
y'forall a. Num a => a -> a -> a
-ℝ
a, ℝ
bforall a. Num a => a -> a -> a
-ℝ
y, ℝ
bforall a. Num a => a -> a -> a
-ℝ
yforall a. Num a => a -> a -> a
-ℝ
stpforall a. Num a => a -> a -> a
*ℝ
y']
       infixl 3 ∪
       (a
a,b
b) ∪ :: (a, b) -> (a, b) -> (a, b)
∪ (a
c,b
d) = (forall a. Ord a => a -> a -> a
min a
a a
c, forall a. Ord a => a -> a -> a
max b
b b
d)


hugeℝVal :: ℝ
hugeℝVal :: ℝ
hugeℝVal = ℝ
1e+100



showℝ :: RealFloat r => r -> String
showℝ :: forall r. RealFloat r => r -> String
showℝ r
x = forall a. Show a => a -> String
show (forall a b. (Real a, Fractional b) => a -> b
realToFrac r
x :: Double)


unsafe_dev_ε_δ :: ∀ a . RealDimension a
                => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ :: forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness a
                      , forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness a ) of
 (LinearManifoldWitness a
LinearManifoldWitness, ClosedScalarWitness a
ClosedScalarWitness) -> \String
errHint a -> a
f Metric a
d
           -> let ε'² :: Scalar a
ε'² = forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric a
d a
1
              in if Scalar a
ε'²forall a. Ord a => a -> a -> Bool
>a
0
                  then let δ :: a
δ = a -> a
f 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 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. Fractional a => a -> a
recip Scalar a
ε'²
                       in if a
δ forall a. Ord a => a -> a -> Bool
> a
0
                           then forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [forall a. Fractional a => a -> a
recip a
δ]
                           else forall a. HasCallStack => String -> a
error forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ String
"ε-δ propagator function for "
                                    forall a. [a] -> [a] -> [a]
++String
errHintforall a. [a] -> [a] -> [a]
++String
", with ε="
                                    forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ (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. Fractional a => a -> a
recip Scalar a
ε'²)
                                    forall a. [a] -> [a] -> [a]
++ String
" gives non-positive δ="
                                    forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ (forall a b. (Real a, Fractional b) => a -> b
realToFrac a
δ)forall a. [a] -> [a] -> [a]
++String
"."
                  else forall a. Monoid a => a
mempty
dev_ε_δ :: ∀ a . RealDimension a
         => (a -> a) -> Metric a -> Maybe (Metric a)
dev_ε_δ :: forall a.
RealDimension a =>
(a -> a) -> Metric a -> Maybe (Metric a)
dev_ε_δ = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness a
                      , forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness a ) of
 (LinearManifoldWitness a
LinearManifoldWitness, ClosedScalarWitness a
ClosedScalarWitness) -> \a -> a
f Metric a
d
           -> let ε'² :: Scalar a
ε'² = forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric a
d a
1
              in if Scalar a
ε'²forall a. Ord a => a -> a -> Bool
>a
0
                  then let δ :: a
δ = a -> a
f 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 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. Fractional a => a -> a
recip Scalar a
ε'²
                       in if a
δ forall a. Ord a => a -> a -> Bool
> a
0
                           then forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [forall a. Fractional a => a -> a
recip a
δ])
                           else forall (f :: * -> *) a. Alternative f => f a
empty
                  else forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall a. Monoid a => a
mempty

as_devεδ :: ∀ a . RealDimension a => LinDevPropag a a -> a -> a
as_devεδ :: forall a. RealDimension a => LinDevPropag a a -> a -> a
as_devεδ = LinearManifoldWitness a
-> ClosedScalarWitness a -> LinDevPropag a a -> a -> a
asdevεδ forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness forall s. Num' s => ClosedScalarWitness s
closedScalarWitness where
 asdevεδ :: LinearManifoldWitness a -> ClosedScalarWitness a -> LinDevPropag a a -> a -> a
 asdevεδ :: LinearManifoldWitness a
-> ClosedScalarWitness a -> LinDevPropag a a -> a -> a
asdevεδ LinearManifoldWitness a
LinearManifoldWitness ClosedScalarWitness a
ClosedScalarWitness
         LinDevPropag a a
ldp a
ε | a
εforall a. Ord a => a -> a -> Bool
>a
0
               , Scalar a
δ'² <- forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq (LinDevPropag a a
ldp forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [forall a. Fractional a => a -> a
recip a
ε]) a
1
               , Scalar a
δ'² forall a. Ord a => a -> a -> Bool
> a
0
                    = 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. Fractional a => a -> a
recip Scalar a
δ'²
               | Bool
otherwise  = a
0


genericiseDifferentiable :: (LocallyScalable s d, LocallyScalable s c)
                    => Differentiable s d c -> Differentiable s d c
genericiseDifferentiable :: forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable (AffinDiffable DiffableEndoProof d c
_ Affine s d c
af)
     = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \d
x -> let (c
y₀, LinearMap s (Needle d) (Needle c)
ϕ) = forall x y s.
(Manifold x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar (Needle x), s ~ Scalar (Needle y)) =>
Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine Affine s d c
af d
x
                              in (c
y₀, LinearMap s (Needle d) (Needle c)
ϕ, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
genericiseDifferentiable Differentiable s d c
f = Differentiable s d c
f


instance RealFrac' s => Category (Differentiable s) where
  type Object (Differentiable s) o = ( Manifold o, Atlas' o
                                     , LocallyScalable s o, SimpleSpace (Needle o) )
  id :: forall a. Object (Differentiable s) a => Differentiable s a a
id = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \a
x -> (a
x, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  Differentiable b -> (c, Needle b +> Needle c, LinDevPropag b c)
f . :: forall a b c.
(Object (Differentiable s) a, Object (Differentiable s) b,
 Object (Differentiable s) c) =>
Differentiable s b c
-> Differentiable s a b -> Differentiable s a c
. Differentiable a -> (b, Needle a +> Needle b, LinDevPropag a b)
g = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
     \a
x -> let (b
y, Needle a +> Needle b
g', LinDevPropag a b
devg) = a -> (b, Needle a +> Needle b, LinDevPropag a b)
g a
x
               (c
z, Needle b +> Needle c
f', LinDevPropag b c
devf) = b -> (c, Needle b +> Needle c, LinDevPropag b c)
f b
y
               devfg :: Norm (Needle c) -> Norm (Needle a)
devfg Norm (Needle c)
δz = let δy :: Norm (Needle b)
δy = forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm Needle b +> Needle c
f' Norm (Needle c)
δz
                              εy :: Norm (Needle b)
εy = LinDevPropag b c
devf Norm (Needle c)
δz
                          in forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm Needle a +> Needle b
g' Norm (Needle b)
εy forall a. Semigroup a => a -> a -> a
<> LinDevPropag a b
devg Norm (Needle b)
δy forall a. Semigroup a => a -> a -> a
<> LinDevPropag a b
devg Norm (Needle b)
εy
           in (c
z, Needle b +> Needle c
f' 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 a +> Needle b
g', Norm (Needle c) -> Norm (Needle a)
devfg)
  AffinDiffable DiffableEndoProof b c
ef Affine s b c
f . AffinDiffable DiffableEndoProof a b
eg Affine s a b
g = forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable (DiffableEndoProof b c
ef 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
. DiffableEndoProof a b
eg) (Affine s b c
f 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
. Affine s a b
g)
  Differentiable s b c
f . Differentiable s a b
g = forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s b c
f 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 d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s a b
g


-- instance (RealDimension s) => EnhancedCat (Differentiable s) (Affine s) where
--   arr (Affine co ao sl) = actuallyAffineEndo (ao .-^ lapply sl co) sl
  
instance (RealDimension s) => EnhancedCat (->) (Differentiable s) where
  arr :: forall b c.
(Object (Differentiable s) b, Object (Differentiable s) c,
 Object (->) b, Object (->) c) =>
Differentiable s b c -> b -> c
arr (Differentiable b -> (c, Needle b +> Needle c, LinDevPropag b c)
f) b
x = let (c
y,Needle b +> Needle c
_,LinDevPropag b c
_) = b -> (c, Needle b +> Needle c, LinDevPropag b c)
f b
x in c
y
  arr (AffinDiffable DiffableEndoProof b c
_ Affine s b c
f) b
x = Affine s b c
f forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ b
x

instance (RealFrac'' s, SimpleSpace s) => Cartesian (Differentiable s) where
  type UnitObject (Differentiable s) = ZeroDim s
  swap :: forall a b.
(ObjectPair (Differentiable s) a b,
 ObjectPair (Differentiable s) b a) =>
Differentiable s (a, b) (b, a)
swap = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(a
x,b
y) -> ((b
y,a
x), forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  attachUnit :: forall unit a.
(unit ~ UnitObject (Differentiable s),
 ObjectPair (Differentiable s) a unit) =>
Differentiable s a (a, unit)
attachUnit = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \a
x -> ((a
x, forall s. ZeroDim s
Origin), forall (k :: * -> * -> *) unit a.
(Cartesian k, unit ~ UnitObject k, ObjectPair k a unit) =>
k a (a, unit)
attachUnit, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  detachUnit :: forall unit a.
(unit ~ UnitObject (Differentiable s),
 ObjectPair (Differentiable s) a unit) =>
Differentiable s (a, unit) a
detachUnit = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(a
x, ZeroDim s
Origin) -> (a
x, forall (k :: * -> * -> *) unit a.
(Cartesian k, unit ~ UnitObject k, ObjectPair k a unit) =>
k (a, unit) a
detachUnit, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  regroup :: forall a b c.
(ObjectPair (Differentiable s) a b,
 ObjectPair (Differentiable s) b c,
 ObjectPair (Differentiable s) a (b, c),
 ObjectPair (Differentiable s) (a, b) c) =>
Differentiable s (a, (b, c)) ((a, b), c)
regroup = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(a
x,(b
y,c
z)) -> (((a
x,b
y),c
z), forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k (a, (b, c)) ((a, b), c)
regroup, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  regroup' :: forall a b c.
(ObjectPair (Differentiable s) a b,
 ObjectPair (Differentiable s) b c,
 ObjectPair (Differentiable s) a (b, c),
 ObjectPair (Differentiable s) (a, b) c) =>
Differentiable s ((a, b), c) (a, (b, c))
regroup' = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \((a
x,b
y),c
z) -> ((a
x,(b
y,c
z)), forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup', forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)


instance ∀ s . (RealFrac'' s, SimpleSpace s) => Morphism (Differentiable s) where
  *** :: forall b b' c c'.
(ObjectPair (Differentiable s) b b',
 ObjectPair (Differentiable s) c c') =>
Differentiable s b c
-> Differentiable s b' c' -> Differentiable s (b, b') (c, c')
(***) = forall b b' c c'.
(ObjectPair (Differentiable s) b b',
 ObjectPair (Differentiable s) c c') =>
Differentiable s b c
-> Differentiable s b' c' -> Differentiable s (b, b') (c, c')
prll
   where prll :: ∀ b β c γ . ( ObjectPair (Differentiable s) b β
                             , ObjectPair (Differentiable s) c γ )
                   => Differentiable s b c -> Differentiable s β γ
                        -> Differentiable s (b,β) (c,γ)
         prll :: forall b b' c c'.
(ObjectPair (Differentiable s) b b',
 ObjectPair (Differentiable s) c c') =>
Differentiable s b c
-> Differentiable s b' c' -> Differentiable s (b, b') (c, c')
prll (Differentiable b -> (c, Needle b +> Needle c, LinDevPropag b c)
f) (Differentiable β -> (γ, Needle β +> Needle γ, LinDevPropag β γ)
g) = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable (b, β)
-> ((c, γ), LinearMap s (Needle b, Needle β) (Needle c, Needle γ),
    Norm (Needle c, Needle γ) -> Norm (Needle b, Needle β))
h
          where h :: (b, β)
-> ((c, γ), LinearMap s (Needle b, Needle β) (Needle c, Needle γ),
    Norm (Needle c, Needle γ) -> Norm (Needle b, Needle β))
h (b
x,β
y) = ((c
fx, γ
gy), Needle b +> Needle c
f'forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
***Needle β +> Needle γ
g', Norm (Needle c, Needle γ) -> Norm (Needle b, Needle β)
devfg)
                 where (c
fx, Needle b +> Needle c
f', LinDevPropag b c
devf) = b -> (c, Needle b +> Needle c, LinDevPropag b c)
f b
x
                       (γ
gy, Needle β +> Needle γ
g', LinDevPropag β γ
devg) = β -> (γ, Needle β +> Needle γ, LinDevPropag β γ)
g β
y
                       devfg :: Norm (Needle c, Needle γ) -> Norm (Needle b, Needle β)
devfg Norm (Needle c, Needle γ)
δs = forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst Norm (Needle b)
δx 
                                  forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd Norm (Needle β)
δy
                         where δx :: Norm (Needle b)
δx = LinDevPropag b c
devf forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall v. AdditiveGroup v => v
zeroV) Norm (Needle c, Needle γ)
δs
                               δy :: Norm (Needle β)
δy = LinDevPropag β γ
devg forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm (forall v. AdditiveGroup v => v
zeroVforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) Norm (Needle c, Needle γ)
δs
         prll (AffinDiffable DiffableEndoProof b c
IsDiffableEndo Affine s b c
f) (AffinDiffable DiffableEndoProof β γ
IsDiffableEndo Affine s β γ
g)
                 = case ( forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @b, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @β
                        , forall m. SemimanifoldWithBoundary m => SmfdWBoundWitness m
smfdWBoundWitness @b, forall m. SemimanifoldWithBoundary m => SmfdWBoundWitness m
smfdWBoundWitness @β
                        , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle b), forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle β)
                        , forall m. SemimanifoldWithBoundary m => SmfdWBoundWitness m
smfdWBoundWitness @s
                        ) of
           ( SemimanifoldWitness b
SemimanifoldWitness, SemimanifoldWitness β
SemimanifoldWitness
            ,SmfdWBoundWitness b
OpenManifoldWitness, SmfdWBoundWitness β
OpenManifoldWitness
            ,DualSpaceWitness (Needle b)
DualSpaceWitness, DualSpaceWitness (Needle β)
DualSpaceWitness
            ,SmfdWBoundWitness s
OpenManifoldWitness )
             -> forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle b)
                 ( forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle β)
                 ( forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d. DiffableEndoProof d d
IsDiffableEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Affine s b c
f forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Affine s β γ
g ))
         prll (AffinDiffable DiffableEndoProof b c
_ Affine s b c
f) (AffinDiffable DiffableEndoProof β γ
_ Affine s β γ
g)
          = forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle β) (
             forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle γ) (
              forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle b) (
               forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle c) (
              case ( forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @β, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @γ
                   , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @b, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @c ) of
                 (SemimanifoldWitness β
SemimanifoldWitness, SemimanifoldWitness γ
SemimanifoldWitness
                  , SemimanifoldWitness b
SemimanifoldWitness, SemimanifoldWitness c
SemimanifoldWitness)
                   -> forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d c. DiffableEndoProof d c
NotDiffableEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Affine s b c
f forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Affine s β γ
g
             ))))
         prll Differentiable s b c
f Differentiable s β γ
g = forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s b c
f forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s β γ
g


instance (RealFrac'' s, SimpleSpace s) => PreArrow (Differentiable s) where
  terminal :: forall b.
Object (Differentiable s) b =>
Differentiable s b (UnitObject (Differentiable s))
terminal = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \b
_ -> (forall s. ZeroDim s
Origin, forall v. AdditiveGroup v => v
zeroV, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  fst :: forall x y.
ObjectPair (Differentiable s) x y =>
Differentiable s (x, y) x
fst = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(x
x,y
_) -> (x
x, forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  snd :: forall x y.
ObjectPair (Differentiable s) x y =>
Differentiable s (x, y) y
snd = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(x
_,y
y) -> (y
y, forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  Differentiable b -> (c, Needle b +> Needle c, LinDevPropag b c)
f &&& :: forall b c c'.
(Object (Differentiable s) b,
 ObjectPair (Differentiable s) c c') =>
Differentiable s b c
-> Differentiable s b c' -> Differentiable s b (c, c')
&&& Differentiable b -> (c', Needle b +> Needle c', LinDevPropag b c')
g = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable b
-> ((c, c'), LinearMap s (Needle b) (Needle c, Needle c'),
    Norm (Needle c, Needle c') -> Norm (Needle b))
h
   where h :: b
-> ((c, c'), LinearMap s (Needle b) (Needle c, Needle c'),
    Norm (Needle c, Needle c') -> Norm (Needle b))
h b
x = ((c
fx, c'
gx), Needle b +> Needle c
f'forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&Needle b +> Needle c'
g', Norm (Needle c, Needle c') -> Norm (Needle b)
devfg)
          where (c
fx, Needle b +> Needle c
f', LinDevPropag b c
devf) = b -> (c, Needle b +> Needle c, LinDevPropag b c)
f b
x
                (c'
gx, Needle b +> Needle c'
g', LinDevPropag b c'
devg) = b -> (c', Needle b +> Needle c', LinDevPropag b c')
g b
x
                devfg :: Norm (Needle c, Needle c') -> Norm (Needle b)
devfg Norm (Needle c, Needle c')
δs = (LinDevPropag b c
devf forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm (forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall v. AdditiveGroup v => v
zeroV) Norm (Needle c, Needle c')
δs)
                           forall a. Semigroup a => a -> a -> a
<> (LinDevPropag b c'
devg forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm (forall v. AdditiveGroup v => v
zeroVforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) Norm (Needle c, Needle c')
δs)
  Differentiable s b c
f &&& Differentiable s b c'
g = forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s b c
f forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s b c'
g


instance (RealFrac'' s, SimpleSpace s) => WellPointed (Differentiable s) where
  unit :: CatTagged (Differentiable s) (UnitObject (Differentiable s))
unit = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall s. ZeroDim s
Origin
  globalElement :: forall x.
ObjectPoint (Differentiable s) x =>
x -> Differentiable s (UnitObject (Differentiable s)) x
globalElement x
x = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ZeroDim s
Origin -> (x
x, forall v. AdditiveGroup v => v
zeroV, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)
  const :: forall b x.
(Object (Differentiable s) b, ObjectPoint (Differentiable s) x) =>
x -> Differentiable s b x
const x
x = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \b
_ -> (x
x, forall v. AdditiveGroup v => v
zeroV, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)



type DfblFuncValue s = GenericAgent (Differentiable s)

instance (RealFrac'' s) => HasAgent (Differentiable s) where
  alg :: forall a b.
(Object (Differentiable s) a, Object (Differentiable s) b) =>
(forall q.
 Object (Differentiable s) q =>
 AgentVal (Differentiable s) q a -> AgentVal (Differentiable s) q b)
-> Differentiable s a b
alg = forall (k :: * -> * -> *) a b.
(HasAgent k, Object k a, Object k b) =>
(forall q. Object k q => GenericAgent k q a -> GenericAgent k q b)
-> k a b
genericAlg
  $~ :: forall a b c.
(Object (Differentiable s) a, Object (Differentiable s) b,
 Object (Differentiable s) c) =>
Differentiable s b c
-> AgentVal (Differentiable s) a b
-> AgentVal (Differentiable s) a c
($~) = forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> GenericAgent k a b -> GenericAgent k a c
genericAgentMap
instance ∀ s . (RealFloat'' s, SimpleSpace s) => CartesianAgent (Differentiable s) where
  alg1to2 :: forall a b c.
(Object (Differentiable s) a, ObjectPair (Differentiable s) b c) =>
(forall q.
 Object (Differentiable s) q =>
 AgentVal (Differentiable s) q a
 -> (AgentVal (Differentiable s) q b,
     AgentVal (Differentiable s) q c))
-> Differentiable s a (b, c)
alg1to2 = forall (k :: * -> * -> *) u a b c.
(PreArrow k, u ~ UnitObject k, Object k a, ObjectPair k b c) =>
(forall q.
 Object k q =>
 GenericAgent k q a -> (GenericAgent k q b, GenericAgent k q c))
-> k a (b, c)
genericAlg1to2
  alg2to1 :: forall a b c.
(ObjectPair (Differentiable s) a b, Object (Differentiable s) c) =>
(forall q.
 Object (Differentiable s) q =>
 AgentVal (Differentiable s) q a
 -> AgentVal (Differentiable s) q b
 -> AgentVal (Differentiable s) q c)
-> Differentiable s (a, b) c
alg2to1 = forall α β γ.
(Manifold α, Manifold β, Atlas' α, Atlas' β, ProjectableBoundary α,
 LocallyScalable s α, LocallyScalable s β) =>
(forall q.
 (LocallyScalable s q, Manifold q, Atlas q,
  Interior (Needle q) ~ Needle q,
  PseudoAffineWithBoundary (Needle q), LinearManifold (Needle q),
  SimpleSpace (Needle q), HasTrie (ChartIndex q)) =>
 DfblFuncValue s q α -> DfblFuncValue s q β -> DfblFuncValue s q γ)
-> Differentiable s (α, β) γ
a2t1
   where a2t1 :: ∀ α β γ . ( Manifold α, Manifold β
                           , Atlas' α, Atlas' β
                           , ProjectableBoundary α
                           , LocallyScalable s α, LocallyScalable s β
                           )
           => (∀ q . ( LocallyScalable s q, Manifold q, Atlas q
                     , Interior (Needle q) ~ Needle q
                     , PseudoAffineWithBoundary (Needle q)
                     , LinearManifold (Needle q)
                     , SimpleSpace (Needle q)
                     , HasTrie (ChartIndex q) )
               => DfblFuncValue s q α -> DfblFuncValue s q β -> DfblFuncValue s q γ )
           -> Differentiable s (α,β) γ
         a2t1 :: forall α β γ.
(Manifold α, Manifold β, Atlas' α, Atlas' β, ProjectableBoundary α,
 LocallyScalable s α, LocallyScalable s β) =>
(forall q.
 (LocallyScalable s q, Manifold q, Atlas q,
  Interior (Needle q) ~ Needle q,
  PseudoAffineWithBoundary (Needle q), LinearManifold (Needle q),
  SimpleSpace (Needle q), HasTrie (ChartIndex q)) =>
 DfblFuncValue s q α -> DfblFuncValue s q β -> DfblFuncValue s q γ)
-> Differentiable s (α, β) γ
a2t1 forall q.
(LocallyScalable s q, Manifold q, Atlas q,
 Interior (Needle q) ~ Needle q,
 PseudoAffineWithBoundary (Needle q), LinearManifold (Needle q),
 SimpleSpace (Needle q), HasTrie (ChartIndex q)) =>
DfblFuncValue s q α -> DfblFuncValue s q β -> DfblFuncValue s q γ
f = case ( forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @α, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @β
                       , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle α), forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle β) ) of
            ( SemimanifoldWitness α
SemimanifoldWitness, SemimanifoldWitness β
SemimanifoldWitness
             ,DualSpaceWitness (Needle α)
DualSpaceWitness, DualSpaceWitness (Needle β)
DualSpaceWitness )
                -> forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @α
                    (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @β
                      (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @α
                        (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @β
                          (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle α)
                            (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle β)
                              (forall a. HasCallStack => a
undefined -- genericAlg2to1 f
                                     ))))))
  alg2to2 :: forall a b c d.
(ObjectPair (Differentiable s) a b,
 ObjectPair (Differentiable s) c d) =>
(forall q.
 Object (Differentiable s) q =>
 AgentVal (Differentiable s) q a
 -> AgentVal (Differentiable s) q b
 -> (AgentVal (Differentiable s) q c,
     AgentVal (Differentiable s) q d))
-> Differentiable s (a, b) (c, d)
alg2to2 = forall α β γ δ.
(Manifold α, Manifold β, Manifold γ, Manifold δ, Atlas' α,
 Atlas' β, Atlas' γ, Atlas' δ, LocallyScalable s α,
 LocallyScalable s β, LocallyScalable s γ, LocallyScalable s δ) =>
(forall q.
 (LocallyScalable s q, Manifold q, Atlas q,
  Interior (Needle q) ~ Needle q,
  PseudoAffineWithBoundary (Needle q), LinearManifold (Needle q),
  SimpleSpace (Needle q), HasTrie (ChartIndex q)) =>
 DfblFuncValue s q α
 -> DfblFuncValue s q β
 -> (DfblFuncValue s q γ, DfblFuncValue s q δ))
-> Differentiable s (α, β) (γ, δ)
a2t1
   where a2t1 :: ∀ α β γ δ . ( Manifold α, Manifold β, Manifold γ, Manifold δ
                             , Atlas' α, Atlas' β, Atlas' γ, Atlas' δ
                             , LocallyScalable s α, LocallyScalable s β
                             , LocallyScalable s γ, LocallyScalable s δ )
           => (∀ q . ( LocallyScalable s q, Manifold q, Atlas q
                     , Interior (Needle q) ~ Needle q
                     , PseudoAffineWithBoundary (Needle q)
                     , LinearManifold (Needle q)
                     , SimpleSpace (Needle q)
                     , HasTrie (ChartIndex q) )
               => DfblFuncValue s q α -> DfblFuncValue s q β
                     -> (DfblFuncValue s q γ, DfblFuncValue s q δ) )
           -> Differentiable s (α,β) (γ,δ)
         a2t1 :: forall α β γ δ.
(Manifold α, Manifold β, Manifold γ, Manifold δ, Atlas' α,
 Atlas' β, Atlas' γ, Atlas' δ, LocallyScalable s α,
 LocallyScalable s β, LocallyScalable s γ, LocallyScalable s δ) =>
(forall q.
 (LocallyScalable s q, Manifold q, Atlas q,
  Interior (Needle q) ~ Needle q,
  PseudoAffineWithBoundary (Needle q), LinearManifold (Needle q),
  SimpleSpace (Needle q), HasTrie (ChartIndex q)) =>
 DfblFuncValue s q α
 -> DfblFuncValue s q β
 -> (DfblFuncValue s q γ, DfblFuncValue s q δ))
-> Differentiable s (α, β) (γ, δ)
a2t1 forall q.
(LocallyScalable s q, Manifold q, Atlas q,
 Interior (Needle q) ~ Needle q,
 PseudoAffineWithBoundary (Needle q), LinearManifold (Needle q),
 SimpleSpace (Needle q), HasTrie (ChartIndex q)) =>
DfblFuncValue s q α
-> DfblFuncValue s q β
-> (DfblFuncValue s q γ, DfblFuncValue s q δ)
f = case ( forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @α, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @β
                       , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @γ, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @δ
                       , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle α), forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle β)
                       , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle γ), forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle δ) ) of
            ( SemimanifoldWitness α
SemimanifoldWitness, SemimanifoldWitness β
SemimanifoldWitness
             ,SemimanifoldWitness γ
SemimanifoldWitness, SemimanifoldWitness δ
SemimanifoldWitness
             ,DualSpaceWitness (Needle α)
DualSpaceWitness, DualSpaceWitness (Needle β)
DualSpaceWitness
             ,DualSpaceWitness (Needle γ)
DualSpaceWitness, DualSpaceWitness (Needle δ)
DualSpaceWitness )
                 -> forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @α
                    (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @β
                     (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @γ
                      (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @δ
                       (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @α
                        (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @β
                         (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @γ
                          (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @δ
                           (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle α)
                            (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle β)
                             (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle γ)
                              (forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @(Needle δ)
                               (forall a. HasCallStack => a
undefined -- genericAlg2to2 f
                                 ))))))))))))
instance (RealFrac'' s, SimpleSpace s)
      => PointAgent (DfblFuncValue s) (Differentiable s) a x where
  point :: (Object (Differentiable s) a, Object (Differentiable s) x) =>
x -> DfblFuncValue s a x
point = forall (k :: * -> * -> *) a x.
(WellPointed k, Object k a, ObjectPoint k x) =>
x -> GenericAgent k a x
genericPoint


actuallyLinearEndo :: (Object (Affine s) x, Object (LinearMap s) x)
            => (x+>x) -> Differentiable s x x
actuallyLinearEndo :: forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo = forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d. DiffableEndoProof d d
IsDiffableEndo 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 (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

actuallyAffineEndo :: (Object (Affine s) x, Object (LinearMap s) x)
            => x -> (x+>Needle x) -> Differentiable s x x
actuallyAffineEndo :: forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo x
y₀ x +> Needle x
f = forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d. DiffableEndoProof d d
IsDiffableEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y s.
(LinearSpace x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar x, s ~ Scalar (Needle y)) =>
y -> LinearMap s x (Needle y) -> Affine s x y
fromOffsetSlope x
y₀ x +> Needle x
f


actuallyLinear :: ( Object (Affine s) x, Object (Affine s) y
                  , Object (LinearMap s) x, Object (LinearMap s) y )
            => (x+>y) -> Differentiable s x y
actuallyLinear :: forall s x y.
(Object (Affine s) x, Object (Affine s) y, Object (LinearMap s) x,
 Object (LinearMap s) y) =>
(x +> y) -> Differentiable s x y
actuallyLinear = forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d c. DiffableEndoProof d c
NotDiffableEndo 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 (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

actuallyAffine :: ( Object (Affine s) x, Object (Affine s) y
                  , Object (LinearMap s) x, Object (LinearMap s) (Needle y) )
            => y -> (x+>Needle y) -> Differentiable s x y
actuallyAffine :: forall s x y.
(Object (Affine s) x, Object (Affine s) y, Object (LinearMap s) x,
 Object (LinearMap s) (Needle y)) =>
y -> (x +> Needle y) -> Differentiable s x y
actuallyAffine y
y₀ x +> Needle y
f = forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d c. DiffableEndoProof d c
NotDiffableEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x y s.
(LinearSpace x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar x, s ~ Scalar (Needle y)) =>
y -> LinearMap s x (Needle y) -> Affine s x y
fromOffsetSlope y
y₀ x +> Needle y
f


-- affinPoint :: (WithField s LinearManifold c, WithField s LinearManifold d)
--                   => c -> DfblFuncValue s d c
-- affinPoint p = GenericAgent (AffinDiffable (const p))


dfblFnValsFunc :: ∀ c c' d v v' ε s
     . ( Manifold c, Manifold d, Manifold c'
       , Atlas' c, Atlas' d, Atlas' c'
       , ProjectableBoundary s, ProjectableBoundary v'
       , ProjectableBoundary (Needle d)
       , SimpleSpace (Needle d)
       , LocallyScalable s c, LocallyScalable s c', LocallyScalable s d
       , v ~ Needle c, v' ~ Needle c'
       , ε ~ Norm v, ε ~ Norm v'
       , SimpleSpace v'
       , RealFrac'' s )
             => (c' -> (c, v'+>v, ε->ε)) -> DfblFuncValue s d c' -> DfblFuncValue s d c
dfblFnValsFunc :: forall c c' d v v' ε s.
(Manifold c, Manifold d, Manifold c', Atlas' c, Atlas' d,
 Atlas' c', ProjectableBoundary s, ProjectableBoundary v',
 ProjectableBoundary (Needle d), SimpleSpace (Needle d),
 LocallyScalable s c, LocallyScalable s c', LocallyScalable s d,
 v ~ Needle c, v' ~ Needle c', ε ~ Norm v, ε ~ Norm v',
 SimpleSpace v', RealFrac'' s) =>
(c' -> (c, v' +> v, ε -> ε))
-> DfblFuncValue s d c' -> DfblFuncValue s d c
dfblFnValsFunc c' -> (c, v' +> v, ε -> ε)
f = case ( forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness @s
                        , forall m. SemimanifoldWithBoundary m => SmfdWBoundWitness m
smfdWBoundWitness @s
                        , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @d
                        , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @c' ) of
   ( ScalarSpaceWitness s
ScalarSpaceWitness, SmfdWBoundWitness s
OpenManifoldWitness
    ,SemimanifoldWitness d
SemimanifoldWitness, SemimanifoldWitness c'
SemimanifoldWitness )
        -> forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @c (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @d (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable c' -> (c, v' +> v, ε -> ε)
f forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> AgentVal k a b -> AgentVal k a c
$~))

dfblFnValsCombine :: forall d c c' c'' v v' v'' ε ε' ε'' s. 
         ( LocallyScalable s c,  LocallyScalable s c',  LocallyScalable s c''
         ,  LocallyScalable s d
         , v ~ Needle c, v' ~ Needle c', v'' ~ Needle c''
         , ε ~ Norm v  , ε' ~ Norm v'  , ε'' ~ Norm v'', ε~ε', ε~ε'' 
         , SimpleSpace (Needle d)
         , RealFrac' s )
       => (  c' -> c'' -> (c, (v',v'')+>v, ε -> (ε',ε''))  )
         -> DfblFuncValue s d c' -> DfblFuncValue s d c'' -> DfblFuncValue s d c
dfblFnValsCombine :: forall d c c' c'' v v' v'' ε ε' ε'' s.
(LocallyScalable s c, LocallyScalable s c', LocallyScalable s c'',
 LocallyScalable s d, v ~ Needle c, v' ~ Needle c',
 v'' ~ Needle c'', ε ~ Norm v, ε' ~ Norm v', ε'' ~ Norm v'', ε ~ ε',
 ε ~ ε'', SimpleSpace (Needle d), RealFrac' s) =>
(c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε'')))
-> DfblFuncValue s d c'
-> DfblFuncValue s d c''
-> DfblFuncValue s d c
dfblFnValsCombine c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb (GenericAgent (Differentiable d -> (c', Needle d +> Needle c', LinDevPropag d c')
f))
                      (GenericAgent (Differentiable d -> (c'', Needle d +> Needle c'', LinDevPropag d c'')
g)) 
    = forall {k} {k1} (k2 :: k -> k1 -> *) (a :: k) (v :: k1).
k2 a v -> GenericAgent k2 a v
GenericAgent 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 d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
        \d
d -> let (c'
c', Needle d +> Needle c'
jf, LinDevPropag d c'
devf) = d -> (c', Needle d +> Needle c', LinDevPropag d c')
f d
d
                  (c''
c'', Needle d +> Needle c''
jg, LinDevPropag d c''
devg) = d -> (c'', Needle d +> Needle c'', LinDevPropag d c'')
g d
d
                  (c
c, (v', v'') +> v
jh, ε -> (ε', ε'')
devh) = c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb c'
c' c''
c''
                  jhl :: LinearMap s v' v
jhl = (v', v'') +> v
jh 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 κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall v. AdditiveGroup v => v
zeroV); jhr :: LinearMap s v'' v
jhr = (v', v'') +> v
jh 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 v. AdditiveGroup v => v
zeroVforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
              in ( c
c
                 , (v', v'') +> v
jh 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 d +> Needle c'
jfforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&Needle d +> Needle c''
jg
                 , \ε
εc -> let εc' :: Norm v'
εc' = forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s v' v
jhl ε
εc
                              εc'' :: Norm v''
εc'' = forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s v'' v
jhr ε
εc
                              (ε'
δc',ε''
δc'') = ε -> (ε', ε'')
devh ε
εc 
                          in LinDevPropag d c'
devf Norm v'
εc' forall a. Semigroup a => a -> a -> a
<> LinDevPropag d c''
devg Norm v''
εc''
                               forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm Needle d +> Needle c'
jf ε'
δc'
                               forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm Needle d +> Needle c''
jg ε''
δc''
                 )
dfblFnValsCombine c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb (GenericAgent Differentiable s d c'
fa) (GenericAgent Differentiable s d c''
ga) 
         = forall d c c' c'' v v' v'' ε ε' ε'' s.
(LocallyScalable s c, LocallyScalable s c', LocallyScalable s c'',
 LocallyScalable s d, v ~ Needle c, v' ~ Needle c',
 v'' ~ Needle c'', ε ~ Norm v, ε' ~ Norm v', ε'' ~ Norm v'', ε ~ ε',
 ε ~ ε'', SimpleSpace (Needle d), RealFrac' s) =>
(c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε'')))
-> DfblFuncValue s d c'
-> DfblFuncValue s d c''
-> DfblFuncValue s d c
dfblFnValsCombine c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb (forall {k} {k1} (k2 :: k -> k1 -> *) (a :: k) (v :: k1).
k2 a v -> GenericAgent k2 a v
GenericAgent forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s d c'
fa)
                                 (forall {k} {k1} (k2 :: k -> k1 -> *) (a :: k) (v :: k1).
k2 a v -> GenericAgent k2 a v
GenericAgent forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable s d c''
ga)





instance ∀ v s a . ( LinearManifold v, Scalar v ~ s
                   , LocallyScalable s a, Manifold a, Atlas' a, Atlas' v
                   , SimpleSpace v, SimpleSpace (Needle a)
                   , RealFloat'' s )
    => AdditiveGroup (DfblFuncValue s a v) where
  zeroV :: DfblFuncValue s a v
zeroV = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @v, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @v
               , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @a
               ) of
     (LinearManifoldWitness v
LinearManifoldWitness, DualSpaceWitness v
DualSpaceWitness, SemimanifoldWitness a
SemimanifoldWitness)
         -> forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @a (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Scalar (Needle (Interior m))) => r) -> r
scalarIsOpenMfd @a
               (forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a (forall (p :: * -> * -> *) (k :: * -> * -> *) a x.
(PointAgent p k a x, Object k a, Object k x) =>
x -> p a x
point forall v. AdditiveGroup v => v
zeroV)))
  ^+^ :: DfblFuncValue s a v -> DfblFuncValue s a v -> DfblFuncValue s a v
(^+^) = forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @a ( forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a
               (case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @v
                     , forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @(Needle a)
                     , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @v
                     , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle a) ) of
     (LinearManifoldWitness v
LinearManifoldWitness, LinearManifoldWitness (Needle a)
LinearManifoldWitness
      ,DualSpaceWitness v
DualSpaceWitness, DualSpaceWitness (Needle a)
DualSpaceWitness)
         -> forall (k :: * -> * -> *) a b c.
(Curry k, ObjectPair k a b, ObjectMorphism k b c) =>
k (a, b) c -> k a (k b c)
curry forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \case
        (GenericAgent (AffinDiffable DiffableEndoProof a v
ef Affine s a v
f), GenericAgent (AffinDiffable DiffableEndoProof a v
eg Affine s a v
g))
              -> forall {k} {k1} (k2 :: k -> k1 -> *) (a :: k) (v :: k1).
k2 a v -> GenericAgent k2 a v
GenericAgent forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable (DiffableEndoProof a v
efforall a. Semigroup a => a -> a -> a
<>DiffableEndoProof a v
eg) (Affine s a v
fforall v. AdditiveGroup v => v -> v -> v
^+^Affine s a v
g)
        (DfblFuncValue s a v
α,DfblFuncValue s a v
β) -> forall d c c' c'' v v' v'' ε ε' ε'' s.
(LocallyScalable s c, LocallyScalable s c', LocallyScalable s c'',
 LocallyScalable s d, v ~ Needle c, v' ~ Needle c',
 v'' ~ Needle c'', ε ~ Norm v, ε' ~ Norm v', ε'' ~ Norm v'', ε ~ ε',
 ε ~ ε'', SimpleSpace (Needle d), RealFrac' s) =>
(c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε'')))
-> DfblFuncValue s d c'
-> DfblFuncValue s d c''
-> DfblFuncValue s d c
dfblFnValsCombine (\v
a v
b -> (v
aforall v. AdditiveGroup v => v -> v -> v
^+^v
b, 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 w s. AdditiveGroup w => LinearFunction s (w, w) w
addV, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)) DfblFuncValue s a v
α DfblFuncValue s a v
β
    ))
  negateV :: DfblFuncValue s a v -> DfblFuncValue s a v
negateV = forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @a (case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @v, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @v
                                     , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @a
                                     ) of
     (LinearManifoldWitness v
LinearManifoldWitness, DualSpaceWitness v
DualSpaceWitness, SemimanifoldWitness a
SemimanifoldWitness)
         -> forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a (\case
         (GenericAgent (AffinDiffable DiffableEndoProof a v
ef Affine s a v
f))
           -> forall {k} {k1} (k2 :: k -> k1 -> *) (a :: k) (v :: k1).
k2 a v -> GenericAgent k2 a v
GenericAgent forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable DiffableEndoProof a v
ef (forall v. AdditiveGroup v => v -> v
negateV Affine s a v
f)
         DfblFuncValue s a v
α -> forall c c' d v v' ε s.
(Manifold c, Manifold d, Manifold c', Atlas' c, Atlas' d,
 Atlas' c', ProjectableBoundary s, ProjectableBoundary v',
 ProjectableBoundary (Needle d), SimpleSpace (Needle d),
 LocallyScalable s c, LocallyScalable s c', LocallyScalable s d,
 v ~ Needle c, v' ~ Needle c', ε ~ Norm v, ε ~ Norm v',
 SimpleSpace v', RealFrac'' s) =>
(c' -> (c, v' +> v, ε -> ε))
-> DfblFuncValue s d c' -> DfblFuncValue s d c
dfblFnValsFunc (\v
a -> (forall v. AdditiveGroup v => v -> v
negateV v
a, forall v. AdditiveGroup v => v -> v
negateV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall a. Monoid a => a
mempty)) DfblFuncValue s a v
α
      )
    )
  
instance ∀ n a . ( RealFloat'' n, Manifold a, LocallyScalable n a
                 , SimpleSpace (Needle a)
                 , Atlas' a, Atlas' n
                 )
            => Num (DfblFuncValue n a n) where
  fromInteger :: Integer -> DfblFuncValue n a n
fromInteger = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @n, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @n
                     , forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @a, forall s. Num' s => ClosedScalarWitness s
closedScalarWitness @n
                     ) of
     (LinearManifoldWitness n
LinearManifoldWitness, DualSpaceWitness n
DualSpaceWitness, SemimanifoldWitness a
SemimanifoldWitness, ClosedScalarWitness n
ClosedScalarWitness)
         -> forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @a (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Scalar (Needle (Interior m))) => r) -> r
scalarIsOpenMfd @a
               (forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a (forall (p :: * -> * -> *) (k :: * -> * -> *) a x.
(PointAgent p k a x, Object k a, Object k x) =>
x -> p a x
point 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 a. Num a => Integer -> a
fromInteger)))
  + :: DfblFuncValue n a n -> DfblFuncValue n a n -> DfblFuncValue n a n
(+) = case forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness n of
      ClosedScalarWitness n
ClosedScalarWitness -> forall v. AdditiveGroup v => v -> v -> v
(^+^)
  * :: DfblFuncValue n a n -> DfblFuncValue n a n -> DfblFuncValue n a n
(*) = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness n
             , forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness n ) of
      (LinearManifoldWitness n
LinearManifoldWitness, ClosedScalarWitness n
ClosedScalarWitness) -> forall d c c' c'' v v' v'' ε ε' ε'' s.
(LocallyScalable s c, LocallyScalable s c', LocallyScalable s c'',
 LocallyScalable s d, v ~ Needle c, v' ~ Needle c',
 v'' ~ Needle c'', ε ~ Norm v, ε' ~ Norm v', ε'' ~ Norm v'', ε ~ ε',
 ε ~ ε'', SimpleSpace (Needle d), RealFrac' s) =>
(c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε'')))
-> DfblFuncValue s d c'
-> DfblFuncValue s d c''
-> DfblFuncValue s d c
dfblFnValsCombine forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
          \n
a n
b -> ( n
aforall a. Num a => a -> a -> a
*n
b
                  , 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 (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall w s. AdditiveGroup w => LinearFunction s (w, w) w
addV 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 v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
a)forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
***(forall v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
b)
                  , forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(forall r. RealFloat r => r -> String
showℝ n
aforall a. [a] -> [a] -> [a]
++String
"*"forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ n
b) (forall a. Floating a => a -> a
sqrt :: n->n)
                       forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \Norm n
d¹₂ -> (Norm n
d¹₂,Norm n
d¹₂)
                           -- ε δa δb = (a+δa)·(b+δb) - (a·b + (a·δa + b·δb)) 
                           --         = δa·δb
                           --   so choose δa = δb = √ε
                  )
  negate :: DfblFuncValue n a n -> DfblFuncValue n a n
negate = case forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness n of
     ClosedScalarWitness n
ClosedScalarWitness -> forall v. AdditiveGroup v => v -> v
negateV
  abs :: DfblFuncValue n a n -> DfblFuncValue n a n
abs = forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a (
   case (forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @n, forall s. Num' s => ClosedScalarWitness s
closedScalarWitness @n) of
         (LinearManifoldWitness n
LinearManifoldWitness, ClosedScalarWitness n
ClosedScalarWitness) -> forall c c' d v v' ε s.
(Manifold c, Manifold d, Manifold c', Atlas' c, Atlas' d,
 Atlas' c', ProjectableBoundary s, ProjectableBoundary v',
 ProjectableBoundary (Needle d), SimpleSpace (Needle d),
 LocallyScalable s c, LocallyScalable s c', LocallyScalable s d,
 v ~ Needle c, v' ~ Needle c', ε ~ Norm v, ε ~ Norm v',
 SimpleSpace v', RealFrac'' s) =>
(c' -> (c, v' +> v, ε -> ε))
-> DfblFuncValue s d c' -> DfblFuncValue s d c
dfblFnValsFunc forall {a} {k :: * -> * -> *} {a}.
(Scalar a ~ a, Interior a ~ a, DualVector a ~ a, Needle a ~ a,
 Object k a, Category k, LinearSpace (Needle a),
 SemimanifoldWithBoundary (Needle a),
 SemimanifoldWithBoundary (Scalar (Needle a)), Empty (Boundary a),
 ProjectableBoundary a, FiniteDimensional a,
 FiniteDimensional (DualVector a), SemiInner a,
 SemiInner (DualVector a), Num' a, Num' (Scalar (Needle a)), IEEE a,
 IEEE (Scalar a), InnerSpace a, InnerSpace (Scalar a), Atlas a,
 HasTrie (ChartIndex a), Floating (Scalar (Needle a)),
 AdditiveGroup (k a a)) =>
a -> (a, k a a, Norm (Needle a) -> Norm (Needle a))
dfblAbs
          where dfblAbs :: a -> (a, k a a, Norm (Needle a) -> Norm (Needle a))
dfblAbs a
a
                 | a
aforall a. Ord a => a -> a -> Bool
>a
0        = (a
a, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"abs "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ a
a) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \a
ε -> a
a forall a. Num a => a -> a -> a
+ a
εforall a. Fractional a => a -> a -> a
/a
2) 
                 | a
aforall a. Ord a => a -> a -> Bool
<a
0        = (-a
a, forall v. AdditiveGroup v => v -> v
negateV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"abs "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ a
a)
                                       forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \a
ε -> a
εforall a. Fractional a => a -> a -> a
/a
2 forall a. Num a => a -> a -> a
- a
a)
                 | Bool
otherwise  = (a
0, forall v. AdditiveGroup v => v
zeroV, forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm (forall a. Floating a => a -> a
sqrt Scalar (Needle a)
0.5))
     )
  signum :: DfblFuncValue n a n -> DfblFuncValue n a n
signum = forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a (
   case (forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @n, forall s. Num' s => ClosedScalarWitness s
closedScalarWitness @n) of
         (LinearManifoldWitness n
LinearManifoldWitness, ClosedScalarWitness n
ClosedScalarWitness) -> forall c c' d v v' ε s.
(Manifold c, Manifold d, Manifold c', Atlas' c, Atlas' d,
 Atlas' c', ProjectableBoundary s, ProjectableBoundary v',
 ProjectableBoundary (Needle d), SimpleSpace (Needle d),
 LocallyScalable s c, LocallyScalable s c', LocallyScalable s d,
 v ~ Needle c, v' ~ Needle c', ε ~ Norm v, ε ~ Norm v',
 SimpleSpace v', RealFrac'' s) =>
(c' -> (c, v' +> v, ε -> ε))
-> DfblFuncValue s d c' -> DfblFuncValue s d c
dfblFnValsFunc forall {p} {a} {b}.
(Interior p ~ p, Needle p ~ p, DualVector p ~ p, Scalar p ~ p,
 LinearSpace (Needle p), SemimanifoldWithBoundary (Needle p),
 SemimanifoldWithBoundary (Scalar (Needle p)), Empty (Boundary p),
 ProjectableBoundary p, FiniteDimensional p,
 FiniteDimensional (DualVector p), SemiInner p,
 SemiInner (DualVector p), Num' p, Num' (Scalar (Needle p)), IEEE p,
 IEEE (Scalar p), InnerSpace p, InnerSpace (Scalar p), Atlas p,
 HasTrie (ChartIndex p), Num a, Num (DualVector (Needle p)),
 AdditiveGroup b) =>
p -> (a, b, Norm (Needle p) -> Norm (Needle p))
dfblSgn
          where dfblSgn :: p -> (a, b, Norm (Needle p) -> Norm (Needle p))
dfblSgn p
a
                 | p
aforall a. Ord a => a -> a -> Bool
>p
0        = (a
1, forall v. AdditiveGroup v => v
zeroV, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"signum "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ p
a) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const p
a)
                 | p
aforall a. Ord a => a -> a -> Bool
<p
0        = (-a
1, forall v. AdditiveGroup v => v
zeroV, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"signum "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ p
a) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \p
_ -> -p
a)
                 | Bool
otherwise  = (a
0, forall v. AdditiveGroup v => v
zeroV, forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [DualVector (Needle p)
1])
     )



-- VectorSpace instance is more problematic than you'd think: multiplication
-- requires the allowed-deviation backpropagators to be split as square
-- roots, but the square root of a nontrivial-vector-space metric requires
-- an eigenbasis transform, which we have not implemented yet.
-- 
-- instance (WithField s LinearManifold v, LocallyScalable s a, Floating s)
--       => VectorSpace (DfblFuncValue s a v) where
--   type Scalar (DfblFuncValue s a v) = DfblFuncValue s a (Scalar v)
--   (*^) = dfblFnValsCombine $ \μ v -> (μ*^v, lScl, \ε -> (ε ^* sqrt 2, ε ^* sqrt 2))
--       where lScl = linear $ uncurry (*^)


-- | Important special operator needed to compute intersection of 'Region's.
minDblfuncs :: ∀ m s . (LocallyScalable s m, RealFloat'' s)
     => Differentiable s m s -> Differentiable s m s -> Differentiable s m s
minDblfuncs :: forall m s.
(LocallyScalable s m, RealFloat'' s) =>
Differentiable s m s
-> Differentiable s m s -> Differentiable s m s
minDblfuncs (Differentiable m -> (s, Needle m +> Needle s, Norm (Needle s) -> Norm (Needle m))
f) (Differentiable m -> (s, Needle m +> Needle s, Norm (Needle s) -> Norm (Needle m))
g)
             = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearManifoldWitness s
-> ClosedScalarWitness s
-> m
-> (s, Needle m +> Needle s, Norm (Needle s) -> Norm (Needle m))
h forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness forall s. Num' s => ClosedScalarWitness s
closedScalarWitness
 where h :: LinearManifoldWitness s -> ClosedScalarWitness s
             -> m -> (s, Needle m+>Needle s, LinDevPropag m s)
       h :: LinearManifoldWitness s
-> ClosedScalarWitness s
-> m
-> (s, Needle m +> Needle s, Norm (Needle s) -> Norm (Needle m))
h (LinearManifoldWitness s
LinearManifoldWitness) ClosedScalarWitness s
ClosedScalarWitness m
x
         | s
fx forall a. Ord a => a -> a -> Bool
< s
gx   = ( s
fx, Needle m +> Needle s
jf
                       , \Norm (Needle s)
d -> Norm (Needle s) -> Norm (Needle m)
devf Norm (Needle s)
d forall a. Semigroup a => a -> a -> a
<> Norm (Needle s) -> Norm (Needle m)
devg Norm (Needle s)
d
                               forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s (Needle m) s
δj
                                      (forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [forall a. Fractional a => a -> a
recip forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Fractional a => a -> a
recip(Norm (Needle s)
dforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|s
1) forall a. Num a => a -> a -> a
+ s
gx forall a. Num a => a -> a -> a
- s
fx]) )
         | s
fx forall a. Ord a => a -> a -> Bool
> s
gx   = ( s
gx, Needle m +> Needle s
jg
                       , \Norm (Needle s)
d -> Norm (Needle s) -> Norm (Needle m)
devf Norm (Needle s)
d forall a. Semigroup a => a -> a -> a
<> Norm (Needle s) -> Norm (Needle m)
devg Norm (Needle s)
d
                               forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s (Needle m) s
δj
                                      (forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [forall a. Fractional a => a -> a
recip forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Fractional a => a -> a
recip(Norm (Needle s)
dforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|s
1) forall a. Num a => a -> a -> a
+ s
fx forall a. Num a => a -> a -> a
- s
gx]) )
         | Bool
otherwise = ( s
fx, (Needle m +> Needle s
jfforall v. AdditiveGroup v => v -> v -> v
^+^Needle m +> Needle s
jg)forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/Scalar (LinearMap s (Needle m) s)
2
                       , \Norm (Needle s)
d -> Norm (Needle s) -> Norm (Needle m)
devf Norm (Needle s)
d forall a. Semigroup a => a -> a -> a
<> Norm (Needle s) -> Norm (Needle m)
devg Norm (Needle s)
d
                               forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s (Needle m) s
δj Norm (Needle s)
d )
        where (s
fx, Needle m +> Needle s
jf, Norm (Needle s) -> Norm (Needle m)
devf) = m -> (s, Needle m +> Needle s, Norm (Needle s) -> Norm (Needle m))
f m
x
              (s
gx, Needle m +> Needle s
jg, Norm (Needle s) -> Norm (Needle m)
devg) = m -> (s, Needle m +> Needle s, Norm (Needle s) -> Norm (Needle m))
g m
x
              δj :: LinearMap s (Needle m) s
δj = Needle m +> Needle s
jf forall v. AdditiveGroup v => v -> v -> v
^-^ Needle m +> Needle s
jg


postEndo :: ∀ c a b . (HasAgent c, Object c a, Object c b)
                        => c a a -> GenericAgent c b a -> GenericAgent c b a
postEndo :: forall (c :: * -> * -> *) a b.
(HasAgent c, Object c a, Object c b) =>
c a a -> GenericAgent c b a -> GenericAgent c b a
postEndo = forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> GenericAgent k a b -> GenericAgent k a c
genericAgentMap



genericisePreRegion :: ∀ m s
    . ( RealFloat'' s, LocallyScalable s m, Manifold m
      , Atlas' m, Atlas' s, SimpleSpace (Needle m)
      )
                          => PreRegion s m -> PreRegion s m
genericisePreRegion :: forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion
 = forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Scalar (Needle (Interior m))) => r) -> r
scalarIsOpenMfd @m (forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @m (forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @m 
    (forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Scalar (Needle (Interior m))) => r) -> r
scalarBoundaryIsTriviallyProjectible @m (
      case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @s, forall s. Num' s => ClosedScalarWitness s
closedScalarWitness @s, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @m ) of
    (LinearManifoldWitness s
LinearManifoldWitness, ClosedScalarWitness s
ClosedScalarWitness, SemimanifoldWitness m
SemimanifoldWitness)
          -> \case
          PreRegion s m
GlobalRegion -> forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const s
1
          RealSubray S⁰_ ℝ
PositiveHalfSphere s
xl -> forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom' s
xl
          RealSubray S⁰_ ℝ
NegativeHalfSphere s
xr -> forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo' s
xr
          PreRegion s m
r -> PreRegion s m
r
  ))))

-- | Set-intersection of regions would not be guaranteed to yield a connected result
--   or even have the reference point of one region contained in the other. This
--   combinator assumes (unchecked) that the references are in a connected
--   sub-intersection, which is used as the result.
unsafePreRegionIntersect :: ∀ a s
    . ( RealFloat'' s, LocallyScalable s a
      , Manifold a, Atlas' a, Atlas' s
      , SimpleSpace (Needle a) )
                  => PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect :: forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion s a
GlobalRegion PreRegion s a
r = PreRegion s a
r
unsafePreRegionIntersect PreRegion s a
r PreRegion s a
GlobalRegion = PreRegion s a
r
unsafePreRegionIntersect (RealSubray S⁰_ ℝ
PositiveHalfSphere s
xl) (RealSubray S⁰_ ℝ
PositiveHalfSphere s
xl')
                 = forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray forall r. S⁰_ r
PositiveHalfSphere forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Ord a => a -> a -> a
max s
xl s
xl'
unsafePreRegionIntersect (RealSubray S⁰_ ℝ
NegativeHalfSphere s
xr) (RealSubray S⁰_ ℝ
NegativeHalfSphere s
xr')
                 = forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray forall r. S⁰_ r
NegativeHalfSphere forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Ord a => a -> a -> a
min s
xr s
xr'
unsafePreRegionIntersect (PreRegion Differentiable s a s
ra) (PreRegion Differentiable s a s
rb) = case forall v. TensorSpace v => ScalarSpaceWitness v
scalarSpaceWitness @s of
      ScalarSpaceWitness s
ScalarSpaceWitness -> forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m s.
(LocallyScalable s m, RealFloat'' s) =>
Differentiable s m s
-> Differentiable s m s -> Differentiable s m s
minDblfuncs Differentiable s a s
ra Differentiable s a s
rb
unsafePreRegionIntersect PreRegion s a
ra PreRegion s a
rb
   = forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect (forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s a
ra) (forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s a
rb)

-- | Cartesian product of two regions.
regionProd :: ∀ a b s . ( RealDimension s, ObjectPair (Differentiable s) a b )
                  => Region s a -> Region s b -> Region s (a,b)
regionProd :: forall a b s.
(RealDimension s, ObjectPair (Differentiable s) a b) =>
Region s a -> Region s b -> Region s (a, b)
regionProd (Region a
a₀ PreRegion s a
ra) (Region b
b₀ PreRegion s b
rb) = forall s m. m -> PreRegion s m -> Region s m
Region (a
a₀,b
b₀) (forall a b s.
(RealDimension s, ObjectPair (Differentiable s) a b) =>
PreRegion s a -> PreRegion s b -> PreRegion s (a, b)
preRegionProd PreRegion s a
ra PreRegion s b
rb)

-- | Cartesian product of two pre-regions.
preRegionProd :: ∀ a b s . ( RealDimension s, ObjectPair (Differentiable s) a b )
                  => PreRegion s a -> PreRegion s b -> PreRegion s (a,b)
preRegionProd :: forall a b s.
(RealDimension s, ObjectPair (Differentiable s) a b) =>
PreRegion s a -> PreRegion s b -> PreRegion s (a, b)
preRegionProd = forall m r.
SemimanifoldWithBoundary m =>
((LinearSpace (Needle (Boundary m)),
  Scalar (Needle (Boundary m)) ~ Scalar (Needle (Interior m))) =>
 r)
-> r
boundaryHasSameScalar @b
              ( case ( forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @a, forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @b
                     , forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @s, forall s. Num' s => ClosedScalarWitness s
closedScalarWitness @s
                     , forall m. SemimanifoldWithBoundary m => SmfdWBoundWitness m
smfdWBoundWitness @b ) of
     ( SemimanifoldWitness a
SemimanifoldWitness, SemimanifoldWitness b
SemimanifoldWitness
      ,LinearManifoldWitness s
LinearManifoldWitness, ClosedScalarWitness s
ClosedScalarWitness
      ,SmfdWBoundWitness b
OpenManifoldWitness ) -> \case
                      PreRegion s a
GlobalRegion -> \case
                          PreRegion s b
GlobalRegion -> forall s m. PreRegion s m
GlobalRegion
                          (PreRegion Differentiable s b s
rb) -> forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s b s
rb 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 (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd
                      (PreRegion Differentiable s a s
ra) -> \case
                          PreRegion s b
GlobalRegion -> forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s a s
ra 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 (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst
                          (PreRegion Differentiable s b s
rb) -> forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m s.
(LocallyScalable s m, RealFloat'' s) =>
Differentiable s m s
-> Differentiable s m s -> Differentiable s m s
minDblfuncs (Differentiable s a s
raforall κ (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) x
fst) (Differentiable s b s
rbforall κ (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
snd)
                      PreRegion s a
ra -> \PreRegion s b
rb -> forall a b s.
(RealDimension s, ObjectPair (Differentiable s) a b) =>
PreRegion s a -> PreRegion s b -> PreRegion s (a, b)
preRegionProd (forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s a
ra)
                                                 (forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s b
rb)
   )


positivePreRegion, negativePreRegion :: (RealDimension s) => PreRegion s s
positivePreRegion :: forall s. RealDimension s => PreRegion s s
positivePreRegion = forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray forall r. S⁰_ r
PositiveHalfSphere s
0
negativePreRegion :: forall s. RealDimension s => PreRegion s s
negativePreRegion = forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray forall r. S⁰_ r
NegativeHalfSphere s
0


positivePreRegion', negativePreRegion' :: ∀ s . (RealDimension s) => PreRegion s s
positivePreRegion' :: forall s. RealDimension s => PreRegion s s
positivePreRegion' = forall s m. Differentiable s m s -> PreRegion s m
PreRegion 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 d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable
                       forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearManifoldWitness s
-> ClosedScalarWitness s
-> s
-> (s, Needle s +> Needle s, LinDevPropag s s)
prr forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness forall s. Num' s => ClosedScalarWitness s
closedScalarWitness
 where prr :: LinearManifoldWitness s -> ClosedScalarWitness s
           -> s -> (s, Needle s+>Needle s, LinDevPropag s s)
       prr :: LinearManifoldWitness s
-> ClosedScalarWitness s
-> s
-> (s, Needle s +> Needle s, LinDevPropag s s)
prr (LinearManifoldWitness s
LinearManifoldWitness) ClosedScalarWitness s
ClosedScalarWitness
           s
x = ( s
1 forall a. Num a => a -> a -> a
- s
1forall a. Fractional a => a -> a -> a
/s
xp1
               , (s
1forall a. Fractional a => a -> a -> a
/s
xp1²) forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
               , forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"positivePreRegion@"forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ s
x) s -> s
δ )
                 -- ε = (1 − 1/(1+x)) + (-δ · 1/(x+1)²) − (1 − 1/(1+x−δ))
                 --   = 1/(1+x−δ) − 1/(1+x) − δ · 1/(x+1)²
                 --
                 -- ε·(1+x−δ) = 1 − (1+x−δ)/(1+x) − δ·(1+x-δ)/(x+1)²
                 -- ε·(1+x) − ε·δ = 1 − 1/(1+x) − x/(1+x) + δ/(1+x)
                 --                               − δ/(x+1)² − δ⋅x/(x+1)² + δ²/(x+1)²
                 --               = 1 − (1+x)/(1+x) + ((x+1) − 1)⋅δ/(x+1)²
                 --                               − δ⋅x/(x+1)² + δ²/(x+1)²
                 --               = 1 − 1 + x⋅δ/(x+1)² − δ⋅x/(x+1)² + δ²/(x+1)²
                 --               = δ²/(x+1)²
                 --
                 -- ε·(x+1)⋅(x+1)² − ε·δ⋅(x+1)² = δ²
                 -- 0 = δ² + ε·(x+1)²·δ − ε·(x+1)³
                 --
                 -- δ = let μ = ε·(x+1)²/2          -- Exact form
                 --     in -μ + √(μ² + ε·(x+1)³)    -- (not overflow save)
                 --
                 -- Safe approximation for large x:
                 -- ε = 1/(1+x−δ) − 1/(1+x) − δ · 1/(x+1)²
                 --   ≤ 1/(1+x−δ) − 1/(1+x)
                 -- 
                 -- ε⋅(1+x−δ)⋅(1+x) ≤ 1+x − (1+x−δ) = δ
                 -- 
                 -- δ ≥ ε + ε⋅x − ε⋅δ + ε⋅x + ε⋅x² − ε⋅δ⋅x
                 --
                 -- δ⋅(1 + ε + ε⋅x) ≥ ε + ε⋅x + ε⋅x + ε⋅x² ≥ ε⋅x²
                 --
                 -- δ ≥ ε⋅x²/(1 + ε + ε⋅x)
                 --   = ε⋅x/(1/x + ε/x + ε)
        where δ :: s -> s
δ s
ε | s
xforall a. Ord a => a -> a -> Bool
<s
100      = let μ :: s
μ = s
εforall a. Num a => a -> a -> a
*s
xp1²forall a. Fractional a => a -> a -> a
/s
2
                                 in forall a. Floating a => a -> a
sqrt(s
μforall a. Num a => a -> Int -> a
^Int
2 forall a. Num a => a -> a -> a
+ s
ε forall a. Num a => a -> a -> a
* s
xp1² forall a. Num a => a -> a -> a
* s
xp1) forall a. Num a => a -> a -> a
- s
μ
                  | Bool
otherwise  = s
ε forall a. Num a => a -> a -> a
* s
x forall a. Fractional a => a -> a -> a
/ ((s
1forall a. Num a => a -> a -> a
+s
ε)forall a. Fractional a => a -> a -> a
/s
x forall a. Num a => a -> a -> a
+ s
ε)
              xp1 :: s
xp1 = (s
xforall a. Num a => a -> a -> a
+s
1)
              xp1² :: s
xp1² = s
xp1 forall a. Num a => a -> Int -> a
^ Int
2
negativePreRegion' :: forall s. RealDimension s => PreRegion s s
negativePreRegion' = LinearManifoldWitness s -> ClosedScalarWitness s -> PreRegion s s
npr (forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness s)
                         (forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness s)
 where npr :: LinearManifoldWitness s -> ClosedScalarWitness s -> PreRegion s s
npr (LinearManifoldWitness s
LinearManifoldWitness)
           (ClosedScalarWitness s
ClosedScalarWitness :: ClosedScalarWitness s)
                  = forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s s s
ppr 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
. Differentiable (Scalar (Needle s)) s s
ngt
        where PreRegion Differentiable s s s
ppr = forall s. RealDimension s => PreRegion s s
positivePreRegion' :: PreRegion s s
              ngt :: Differentiable (Scalar (Needle s)) s s
ngt = forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. AdditiveGroup v => v -> v
negateV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id

preRegionToInfFrom, preRegionFromMinInfTo :: RealDimension s => s -> PreRegion s s
preRegionToInfFrom :: forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom = forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray forall r. S⁰_ r
PositiveHalfSphere
preRegionFromMinInfTo :: forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo = forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray forall r. S⁰_ r
NegativeHalfSphere

preRegionToInfFrom', preRegionFromMinInfTo' :: ∀ s . RealDimension s => s -> PreRegion s s
preRegionToInfFrom' :: forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom' = LinearManifoldWitness s
-> ClosedScalarWitness s -> s -> PreRegion s s
prif (forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness s)
                           (forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness s)
 where prif :: LinearManifoldWitness s
-> ClosedScalarWitness s -> s -> PreRegion s s
prif (LinearManifoldWitness s
LinearManifoldWitness)
            (ClosedScalarWitness s
ClosedScalarWitness :: ClosedScalarWitness s)
            s
xs = forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s s s
ppr 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
. Differentiable s s s
trl
        where PreRegion Differentiable s s s
ppr = forall s. RealDimension s => PreRegion s s
positivePreRegion' :: PreRegion s s
              trl :: Differentiable s s s
trl = forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo (-s
xs) forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
preRegionFromMinInfTo' :: forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo' = LinearManifoldWitness s
-> ClosedScalarWitness s -> s -> PreRegion s s
prif (forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness s)
                           (forall s. Num' s => ClosedScalarWitness s
closedScalarWitness :: ClosedScalarWitness s)
 where prif :: LinearManifoldWitness s
-> ClosedScalarWitness s -> s -> PreRegion s s
prif (LinearManifoldWitness s
LinearManifoldWitness)
            (ClosedScalarWitness s
ClosedScalarWitness :: ClosedScalarWitness s)
            s
xe = forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s s s
ppr 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
. Differentiable s s s
flp
        where PreRegion Differentiable s s s
ppr = forall s. RealDimension s => PreRegion s s
positivePreRegion' :: PreRegion s s
              flp :: Differentiable s s s
flp = forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo s
xe (forall v. AdditiveGroup v => v -> v
negateV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)

intervalPreRegion :: ∀ s . RealDimension s => (s,s) -> PreRegion s s
intervalPreRegion :: forall s. RealDimension s => (s, s) -> PreRegion s s
intervalPreRegion (s
lb,s
rb) = forall s m. Differentiable s m s -> PreRegion s m
PreRegion 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 d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable
                             forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearManifoldWitness s
-> ClosedScalarWitness s
-> s
-> (s, Needle s +> Needle s, LinDevPropag s s)
prr forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness forall s. Num' s => ClosedScalarWitness s
closedScalarWitness
 where m :: s
m = s
lb forall a. Num a => a -> a -> a
+ s
radius; radius :: s
radius = (s
rb forall a. Num a => a -> a -> a
- s
lb)forall a. Fractional a => a -> a -> a
/s
2
       prr :: LinearManifoldWitness s -> ClosedScalarWitness s
                -> s -> (s, Needle s+>Needle s, LinDevPropag s s)
       prr :: LinearManifoldWitness s
-> ClosedScalarWitness s
-> s
-> (s, Needle s +> Needle s, LinDevPropag s s)
prr (LinearManifoldWitness s
LinearManifoldWitness) ClosedScalarWitness s
ClosedScalarWitness
           s
x = ( s
1 forall a. Num a => a -> a -> a
- ((s
xforall a. Num a => a -> a -> a
-s
m)forall a. Fractional a => a -> a -> a
/s
radius)forall a. Num a => a -> Int -> a
^Int
2
               , (s
2forall a. Num a => a -> a -> a
*(s
mforall a. Num a => a -> a -> a
-s
x)forall a. Fractional a => a -> a -> a
/s
radiusforall a. Num a => a -> Int -> a
^Int
2) forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
               , forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"intervalPreRegion@"forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ s
x) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (forall a. Num a => a -> a -> a
*s
radius) 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 a. Floating a => a -> a
sqrt )











instance (RealDimension s) => Category (RWDiffable s) where
  type Object (RWDiffable s) o = Object (Differentiable s) o
  id :: forall a. Object (RWDiffable s) a => RWDiffable s a a
id = forall a. Object (RWDiffable s) a => RWDiffable s a a
rwdid
   where rwdid :: ∀ a . Object (RWDiffable s) a => RWDiffable s a a
         rwdid :: forall a. Object (RWDiffable s) a => RWDiffable s a a
rwdid = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \a
x -> (forall s m. PreRegion s m
GlobalRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
  RWDiffable b -> (PreRegion s b, Maybe (Differentiable s b c))
f . :: forall a b c.
(Object (RWDiffable s) a, Object (RWDiffable s) b,
 Object (RWDiffable s) c) =>
RWDiffable s b c -> RWDiffable s a b -> RWDiffable s a c
. RWDiffable a -> (PreRegion s a, Maybe (Differentiable s a b))
g = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable a -> (PreRegion s a, Maybe (Differentiable s a c))
h where
   h :: a -> (PreRegion s a, Maybe (Differentiable s a c))
h a
x₀ = case a -> (PreRegion s a, Maybe (Differentiable s a b))
g a
x₀ of
           ( PreRegion s a
rg, Just gr' :: Differentiable s a b
gr'@(AffinDiffable DiffableEndoProof a b
IsDiffableEndo Affine s a b
gr) )
            -> let (b
y₀, LinearMap s (Needle a) (Needle b)
ϕg) = forall x y s.
(Manifold x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar (Needle x), s ~ Scalar (Needle y)) =>
Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine Affine s a b
gr a
x₀
               in case b -> (PreRegion s b, Maybe (Differentiable s b c))
f b
y₀ of
                   (PreRegion s b
GlobalRegion, Just (AffinDiffable DiffableEndoProof b c
fe Affine s b c
fr))
                         -> (PreRegion s a
rg, forall a. a -> Maybe a
Just (forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable DiffableEndoProof b c
fe (Affine s b c
frforall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
.Affine s a b
gr)))
                   (PreRegion s b
GlobalRegion, Maybe (Differentiable s b c)
fhr)
                         -> (PreRegion s a
rg, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (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
. Differentiable s a b
gr') Maybe (Differentiable s b c)
fhr)
                   (RealSubray S⁰_ ℝ
diry s
yl, Maybe (Differentiable s b c)
fhr)
                      -> let hhr :: Maybe (Differentiable s s c)
hhr = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (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
. Differentiable s a b
gr') Maybe (Differentiable s b c)
fhr
                         in case LinearMap s (Needle a) (Needle b)
ϕg forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s
1 of
                              a
y' | a
y'forall a. Ord a => a -> a -> Bool
>a
0 -> ( forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion s a
rg
                                                  forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray S⁰_ ℝ
diry (a
x₀ forall a. Num a => a -> a -> a
+ (s
ylforall a. Num a => a -> a -> a
-b
y₀)forall a. Fractional a => a -> a -> a
/a
y')
                                   -- y'⋅(xl−x₀) + y₀ ≝ yl
                                           , Maybe (Differentiable s s c)
hhr )
                                 | a
y'forall a. Ord a => a -> a -> Bool
<a
0 -> ( forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion s a
rg
                                                  forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s. Num' s => S⁰_ ℝ -> s -> PreRegion s s
RealSubray (S⁰_ ℝ -> S⁰_ ℝ
otherHalfSphere S⁰_ ℝ
diry)
                                                               (a
x₀ forall a. Num a => a -> a -> a
+ (s
ylforall a. Num a => a -> a -> a
-b
y₀)forall a. Fractional a => a -> a -> a
/a
y')
                                           , Maybe (Differentiable s s c)
hhr )
                                 | Bool
otherwise -> (PreRegion s a
rg, Maybe (Differentiable s s c)
hhr)
                   (PreRegion Differentiable s b s
ry, Maybe (Differentiable s b c)
fhr)
                         -> ( forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s b s
ry 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
. Differentiable s a b
gr', forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap (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
. Differentiable s a b
gr') Maybe (Differentiable s b c)
fhr )
           ( PreRegion s a
rg, Just gr' :: Differentiable s a b
gr'@(AffinDiffable DiffableEndoProof a b
_ Affine s a b
gr) )
            -> forall a. HasCallStack => String -> a
error String
"( rg, Just gr'@(AffinDiffable gr) )"
           (PreRegion s a
GlobalRegion, Just gr :: Differentiable s a b
gr@(Differentiable a -> (b, Needle a +> Needle b, LinDevPropag a b)
grd))
            -> let (b
y₀,Needle a +> Needle b
_,LinDevPropag a b
_) = a -> (b, Needle a +> Needle b, LinDevPropag a b)
grd a
x₀
               in case b -> (PreRegion s b, Maybe (Differentiable s b c))
f b
y₀ of
                   (PreRegion s b
GlobalRegion, Maybe (Differentiable s b c)
Nothing)
                         -> (forall s m. PreRegion s m
GlobalRegion, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
                   (PreRegion s b
GlobalRegion, Just Differentiable s b c
fr)
                         -> (forall s m. PreRegion s m
GlobalRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Differentiable s b c
fr 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
. Differentiable s a b
gr))
                   (PreRegion s b
r, Maybe (Differentiable s b c)
Nothing) | PreRegion Differentiable s b s
ry <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s b
r
                         -> ( forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s b s
ry 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
. Differentiable s a b
gr, forall s d c. Maybe (Differentiable s d c)
notDefinedHere )
                   (PreRegion s b
r, (Just Differentiable s b c
fr)) | PreRegion Differentiable s b s
ry <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s b
r
                         -> ( forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s b s
ry 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
. Differentiable s a b
gr, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Differentiable s b c
fr 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
. Differentiable s a b
gr) )
           (rg :: PreRegion s a
rg@(RealSubray S⁰_ ℝ
_ s
_), Just gr :: Differentiable s a b
gr@(Differentiable a -> (b, Needle a +> Needle b, LinDevPropag a b)
grd))
            -> let (b
y₀,Needle a +> Needle b
_,LinDevPropag a b
_) = a -> (b, Needle a +> Needle b, LinDevPropag a b)
grd a
x₀
               in case b -> (PreRegion s b, Maybe (Differentiable s b c))
f b
y₀ of
                   (PreRegion s b
GlobalRegion, Maybe (Differentiable s b c)
Nothing)
                         -> (PreRegion s a
rg, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
                   (PreRegion s b
GlobalRegion, Just Differentiable s b c
fr)
                         -> (PreRegion s a
rg, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Differentiable s b c
fr 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
. Differentiable s a b
gr))
                   (PreRegion s b
rf, Maybe (Differentiable s b c)
Nothing)
                     | PreRegion Differentiable s a s
rx <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s a
rg
                     , PreRegion Differentiable s b s
ry <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s b
rf
                         -> ( forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m s.
(LocallyScalable s m, RealFloat'' s) =>
Differentiable s m s
-> Differentiable s m s -> Differentiable s m s
minDblfuncs (Differentiable s b s
ry 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
. Differentiable s a b
gr) Differentiable s a s
rx
                            , forall s d c. Maybe (Differentiable s d c)
notDefinedHere )
                   (PreRegion s b
rf, Just Differentiable s b c
fr)
                     | PreRegion Differentiable s a s
rx <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s a
rg
                     , PreRegion Differentiable s b s
ry <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s b
rf
                         -> ( forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m s.
(LocallyScalable s m, RealFloat'' s) =>
Differentiable s m s
-> Differentiable s m s -> Differentiable s m s
minDblfuncs (Differentiable s b s
ry 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
. Differentiable s a b
gr) Differentiable s a s
rx
                            , forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Differentiable s b c
fr 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
. Differentiable s a b
gr) )
           (PreRegion Differentiable s a s
rx, Just gr :: Differentiable s a b
gr@(Differentiable a -> (b, Needle a +> Needle b, LinDevPropag a b)
grd))
            -> let (b
y₀,Needle a +> Needle b
_,LinDevPropag a b
_) = a -> (b, Needle a +> Needle b, LinDevPropag a b)
grd a
x₀
               in case b -> (PreRegion s b, Maybe (Differentiable s b c))
f b
y₀ of
                   (PreRegion s b
GlobalRegion, Maybe (Differentiable s b c)
Nothing)
                         -> (forall s m. Differentiable s m s -> PreRegion s m
PreRegion Differentiable s a s
rx, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
                   (PreRegion s b
GlobalRegion, Just Differentiable s b c
fr)
                         -> (forall s m. Differentiable s m s -> PreRegion s m
PreRegion Differentiable s a s
rx, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Differentiable s b c
fr 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
. Differentiable s a b
gr))
                   (PreRegion s b
r, Maybe (Differentiable s b c)
Nothing) | PreRegion Differentiable s b s
ry <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s b
r
                         -> ( forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m s.
(LocallyScalable s m, RealFloat'' s) =>
Differentiable s m s
-> Differentiable s m s -> Differentiable s m s
minDblfuncs (Differentiable s b s
ry 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
. Differentiable s a b
gr) Differentiable s a s
rx
                            , forall s d c. Maybe (Differentiable s d c)
notDefinedHere )
                   (PreRegion s b
r, Just Differentiable s b c
fr) | PreRegion Differentiable s b s
ry <- forall m s.
(RealFloat'' s, LocallyScalable s m, Manifold m, Atlas' m,
 Atlas' s, SimpleSpace (Needle m)) =>
PreRegion s m -> PreRegion s m
genericisePreRegion PreRegion s b
r

                         -> ( forall s m. Differentiable s m s -> PreRegion s m
PreRegion forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m s.
(LocallyScalable s m, RealFloat'' s) =>
Differentiable s m s
-> Differentiable s m s -> Differentiable s m s
minDblfuncs (Differentiable s b s
ry 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
. Differentiable s a b
gr) Differentiable s a s
rx
                            , forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Differentiable s b c
fr 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
. Differentiable s a b
gr) )
           (PreRegion s a
r, Maybe (Differentiable s a b)
Nothing)
            -> (PreRegion s a
r, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
          


globalDiffable' :: Differentiable s a b -> RWDiffable s a b
globalDiffable' :: forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' Differentiable s a b
f = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const (forall s m. PreRegion s m
GlobalRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Differentiable s a b
f)



instance (RealDimension s) => EnhancedCat (RWDiffable s) (Differentiable s) where
  arr :: forall b c.
(Object (Differentiable s) b, Object (Differentiable s) c,
 Object (RWDiffable s) b, Object (RWDiffable s) c) =>
Differentiable s b c -> RWDiffable s b c
arr = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable'
                
instance (RealDimension s) => Cartesian (RWDiffable s) where
  type UnitObject (RWDiffable s) = ZeroDim s
  swap :: forall a b.
(ObjectPair (RWDiffable s) a b, ObjectPair (RWDiffable s) b a) =>
RWDiffable s (a, b) (b, a)
swap = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap
  attachUnit :: forall unit a.
(unit ~ UnitObject (RWDiffable s),
 ObjectPair (RWDiffable s) a unit) =>
RWDiffable s a (a, unit)
attachUnit = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (k :: * -> * -> *) unit a.
(Cartesian k, unit ~ UnitObject k, ObjectPair k a unit) =>
k a (a, unit)
attachUnit
  detachUnit :: forall unit a.
(unit ~ UnitObject (RWDiffable s),
 ObjectPair (RWDiffable s) a unit) =>
RWDiffable s (a, unit) a
detachUnit = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (k :: * -> * -> *) unit a.
(Cartesian k, unit ~ UnitObject k, ObjectPair k a unit) =>
k (a, unit) a
detachUnit
  regroup :: forall a b c.
(ObjectPair (RWDiffable s) a b, ObjectPair (RWDiffable s) b c,
 ObjectPair (RWDiffable s) a (b, c),
 ObjectPair (RWDiffable s) (a, b) c) =>
RWDiffable s (a, (b, c)) ((a, b), c)
regroup = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k (a, (b, c)) ((a, b), c)
regroup
  regroup' :: forall a b c.
(ObjectPair (RWDiffable s) a b, ObjectPair (RWDiffable s) b c,
 ObjectPair (RWDiffable s) a (b, c),
 ObjectPair (RWDiffable s) (a, b) c) =>
RWDiffable s ((a, b), c) (a, (b, c))
regroup' = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup'
  
instance (RealDimension s) => Morphism (RWDiffable s) where
  RWDiffable b -> (PreRegion s b, Maybe (Differentiable s b c))
f *** :: forall b b' c c'.
(ObjectPair (RWDiffable s) b b', ObjectPair (RWDiffable s) c c') =>
RWDiffable s b c
-> RWDiffable s b' c' -> RWDiffable s (b, b') (c, c')
*** RWDiffable b' -> (PreRegion s b', Maybe (Differentiable s b' c'))
g = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable (b, b')
-> (PreRegion s (b, b'), Maybe (Differentiable s (b, b') (c, c')))
h
   where h :: (b, b')
-> (PreRegion s (b, b'), Maybe (Differentiable s (b, b') (c, c')))
h (b
x,b'
y) = (forall a b s.
(RealDimension s, ObjectPair (Differentiable s) a b) =>
PreRegion s a -> PreRegion s b -> PreRegion s (a, b)
preRegionProd PreRegion s b
rfx PreRegion s b'
rgy, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c b a.
(Applicative f r t, Object r c, ObjectMorphism r b c,
 Object t (f c), ObjectMorphism t (f b) (f c), ObjectPair r a b,
 ObjectPair t (f a) (f b)) =>
r a (r b c) -> t (f a) (t (f b) (f c))
liftA2 forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) Maybe (Differentiable s b c)
dff Maybe (Differentiable s b' c')
dfg)
          where (PreRegion s b
rfx, Maybe (Differentiable s b c)
dff) = b -> (PreRegion s b, Maybe (Differentiable s b c))
f b
x
                (PreRegion s b'
rgy, Maybe (Differentiable s b' c')
dfg) = b' -> (PreRegion s b', Maybe (Differentiable s b' c'))
g b'
y

instance (RealDimension s) => PreArrow (RWDiffable s) where
  RWDiffable b -> (PreRegion s b, Maybe (Differentiable s b c))
f &&& :: forall b c c'.
(Object (RWDiffable s) b, ObjectPair (RWDiffable s) c c') =>
RWDiffable s b c -> RWDiffable s b c' -> RWDiffable s b (c, c')
&&& RWDiffable b -> (PreRegion s b, Maybe (Differentiable s b c'))
g = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable b -> (PreRegion s b, Maybe (Differentiable s b (c, c')))
h
   where h :: b -> (PreRegion s b, Maybe (Differentiable s b (c, c')))
h b
x = (forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion s b
rfx PreRegion s b
rgx, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c b a.
(Applicative f r t, Object r c, ObjectMorphism r b c,
 Object t (f c), ObjectMorphism t (f b) (f c), ObjectPair r a b,
 ObjectPair t (f a) (f b)) =>
r a (r b c) -> t (f a) (t (f b) (f c))
liftA2 forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
(&&&) Maybe (Differentiable s b c)
dff Maybe (Differentiable s b c')
dfg)
          where (PreRegion s b
rfx, Maybe (Differentiable s b c)
dff) = b -> (PreRegion s b, Maybe (Differentiable s b c))
f b
x
                (PreRegion s b
rgx, Maybe (Differentiable s b c')
dfg) = b -> (PreRegion s b, Maybe (Differentiable s b c'))
g b
x
  terminal :: forall b.
Object (RWDiffable s) b =>
RWDiffable s b (UnitObject (RWDiffable s))
terminal = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (a :: * -> * -> *) b.
(PreArrow a, Object a b) =>
a b (UnitObject a)
terminal
  fst :: forall x y. ObjectPair (RWDiffable s) x y => RWDiffable s (x, y) x
fst = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst
  snd :: forall x y. ObjectPair (RWDiffable s) x y => RWDiffable s (x, y) y
snd = forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd


instance (RealDimension s) => WellPointed (RWDiffable s) where
  unit :: CatTagged (RWDiffable s) (UnitObject (RWDiffable s))
unit = forall {k} (s :: k) b. b -> Tagged s b
Tagged forall s. ZeroDim s
Origin
  globalElement :: forall x.
ObjectPoint (RWDiffable s) x =>
x -> RWDiffable s (UnitObject (RWDiffable s)) x
globalElement x
x = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ZeroDim s
Origin -> (forall s m. PreRegion s m
GlobalRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall (a :: * -> * -> *) x.
(WellPointed a, ObjectPoint a x) =>
x -> a (UnitObject a) x
globalElement x
x))
  const :: forall b x.
(Object (RWDiffable s) b, ObjectPoint (RWDiffable s) x) =>
x -> RWDiffable s b x
const x
x = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \b
_ -> (forall s m. PreRegion s m
GlobalRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const x
x))


data RWDfblFuncValue s d c where
  ConstRWDFV :: c -> RWDfblFuncValue s d c
  RWDFV_IdVar :: RWDfblFuncValue s c c
  GenericRWDFV :: RWDiffable s d c -> RWDfblFuncValue s d c

genericiseRWDFV ::
   ( RealDimension s, Object (Differentiable s) d, Object (Differentiable s) c )
                    => RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV :: forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV (ConstRWDFV c
c) = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const c
c
genericiseRWDFV RWDfblFuncValue s d c
RWDFV_IdVar = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
genericiseRWDFV RWDfblFuncValue s d c
v = RWDfblFuncValue s d c
v

instance RealDimension s => HasAgent (RWDiffable s) where
  type AgentVal (RWDiffable s) d c = RWDfblFuncValue s d c
  alg :: forall a b.
(Object (RWDiffable s) a, Object (RWDiffable s) b) =>
(forall q.
 Object (RWDiffable s) q =>
 AgentVal (RWDiffable s) q a -> AgentVal (RWDiffable s) q b)
-> RWDiffable s a b
alg forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a -> AgentVal (RWDiffable s) q b
fq = case forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a -> AgentVal (RWDiffable s) q b
fq forall s c. RWDfblFuncValue s c c
RWDFV_IdVar of
    GenericRWDFV RWDiffable s a b
f -> RWDiffable s a b
f
    ConstRWDFV b
c -> forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const b
c
    AgentVal (RWDiffable s) a b
RWDfblFuncValue s a b
RWDFV_IdVar -> forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  $~ :: forall a b c.
(Object (RWDiffable s) a, Object (RWDiffable s) b,
 Object (RWDiffable s) c) =>
RWDiffable s b c
-> AgentVal (RWDiffable s) a b -> AgentVal (RWDiffable s) a c
($~) = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW
instance RealDimension s => CartesianAgent (RWDiffable s) where
  alg1to2 :: forall a b c.
(Object (RWDiffable s) a, ObjectPair (RWDiffable s) b c) =>
(forall q.
 Object (RWDiffable s) q =>
 AgentVal (RWDiffable s) q a
 -> (AgentVal (RWDiffable s) q b, AgentVal (RWDiffable s) q c))
-> RWDiffable s a (b, c)
alg1to2 forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a
-> (AgentVal (RWDiffable s) q b, AgentVal (RWDiffable s) q c)
fgq = case forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a
-> (AgentVal (RWDiffable s) q b, AgentVal (RWDiffable s) q c)
fgq forall s c. RWDfblFuncValue s c c
RWDFV_IdVar of
    (GenericRWDFV RWDiffable s a b
f, GenericRWDFV RWDiffable s a c
g) -> RWDiffable s a b
f forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& RWDiffable s a c
g
  alg2to1 :: forall a b c.
(ObjectPair (RWDiffable s) a b, Object (RWDiffable s) c) =>
(forall q.
 Object (RWDiffable s) q =>
 AgentVal (RWDiffable s) q a
 -> AgentVal (RWDiffable s) q b -> AgentVal (RWDiffable s) q c)
-> RWDiffable s (a, b) c
alg2to1 forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a
-> AgentVal (RWDiffable s) q b -> AgentVal (RWDiffable s) q c
fq = case forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a
-> AgentVal (RWDiffable s) q b -> AgentVal (RWDiffable s) q c
fq (forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) (forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) of
    GenericRWDFV RWDiffable s (a, b) c
f -> RWDiffable s (a, b) c
f
  alg2to2 :: forall a b c d.
(ObjectPair (RWDiffable s) a b, ObjectPair (RWDiffable s) c d) =>
(forall q.
 Object (RWDiffable s) q =>
 AgentVal (RWDiffable s) q a
 -> AgentVal (RWDiffable s) q b
 -> (AgentVal (RWDiffable s) q c, AgentVal (RWDiffable s) q d))
-> RWDiffable s (a, b) (c, d)
alg2to2 forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a
-> AgentVal (RWDiffable s) q b
-> (AgentVal (RWDiffable s) q c, AgentVal (RWDiffable s) q d)
fgq = case forall q.
Object (RWDiffable s) q =>
AgentVal (RWDiffable s) q a
-> AgentVal (RWDiffable s) q b
-> (AgentVal (RWDiffable s) q c, AgentVal (RWDiffable s) q d)
fgq (forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) (forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd) of
    (GenericRWDFV RWDiffable s (a, b) c
f, GenericRWDFV RWDiffable s (a, b) d
g) -> RWDiffable s (a, b) c
f forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& RWDiffable s (a, b) d
g
instance (RealDimension s)
      => PointAgent (RWDfblFuncValue s) (RWDiffable s) a x where
  point :: (Object (RWDiffable s) a, Object (RWDiffable s) x) =>
x -> RWDfblFuncValue s a x
point = forall c s d. c -> RWDfblFuncValue s d c
ConstRWDFV

grwDfblFnValsFunc
     :: ( RealDimension s
        , Object (Differentiable s) d, Object (Differentiable s) c, Object (Differentiable s) c'
        , v ~ Needle c, v' ~ Needle c'
        , SimpleSpace v
        , ε ~ Norm v, ε ~ Norm v' )
             => (c' -> (c, v'+>v, ε->ε)) -> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c
grwDfblFnValsFunc :: forall s d c c' v v' ε.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c, Object (Differentiable s) c',
 v ~ Needle c, v' ~ Needle c', SimpleSpace v, ε ~ Norm v,
 ε ~ Norm v') =>
(c' -> (c, v' +> v, ε -> ε))
-> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c
grwDfblFnValsFunc c' -> (c, v' +> v, ε -> ε)
f = (forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable (\c'
_ -> (forall s m. PreRegion s m
GlobalRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable c' -> (c, v' +> v, ε -> ε)
f))) forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> AgentVal k a b -> AgentVal k a c
$~)

grwDfblFnValsCombine :: forall d c c' c'' v v' v'' ε ε' ε'' s. 
         ( RealDimension s
         , Object (Differentiable s) d, Object (Differentiable s) c'
         , Object (Differentiable s) c', Object (Differentiable s) c''
         , v ~ Needle c, v' ~ Needle c', v'' ~ Needle c''
         , SimpleSpace v
         , ε ~ Norm v  , ε' ~ Norm v'  , ε'' ~ Norm v'', ε~ε', ε~ε''  )
       => (  c' -> c'' -> (c, (v',v'')+>v, ε -> (ε',ε''))  )
         -> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c'' -> RWDfblFuncValue s d c
grwDfblFnValsCombine :: forall d c c' c'' v v' v'' ε ε' ε'' s.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c', Object (Differentiable s) c',
 Object (Differentiable s) c'', v ~ Needle c, v' ~ Needle c',
 v'' ~ Needle c'', SimpleSpace v, ε ~ Norm v, ε' ~ Norm v',
 ε'' ~ Norm v'', ε ~ ε', ε ~ ε'') =>
(c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε'')))
-> RWDfblFuncValue s d c'
-> RWDfblFuncValue s d c''
-> RWDfblFuncValue s d c
grwDfblFnValsCombine c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb (GenericRWDFV (RWDiffable d -> (PreRegion s d, Maybe (Differentiable s d c'))
fpcs))
                         (GenericRWDFV (RWDiffable d -> (PreRegion s d, Maybe (Differentiable s d c''))
gpcs)) 
    = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
        \d
d₀ -> let (PreRegion s d
rc', Maybe (Differentiable s d c')
fmay) = d -> (PreRegion s d, Maybe (Differentiable s d c'))
fpcs d
d₀
                   (PreRegion s d
rc'',Maybe (Differentiable s d c'')
gmay) = d -> (PreRegion s d, Maybe (Differentiable s d c''))
gpcs d
d₀
               in (forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion s d
rc' PreRegion s d
rc'',) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                    case (forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiableforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>Maybe (Differentiable s d c')
fmay, forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiableforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>Maybe (Differentiable s d c'')
gmay) of
                      (Just(Differentiable d -> (c', Needle d +> Needle c', LinDevPropag d c')
f), Just(Differentiable d -> (c'', Needle d +> Needle c'', LinDevPropag d c'')
g)) ->
                        forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure 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 d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \d
d
                         -> let (c'
c', Needle d +> Needle c'
jf, LinDevPropag d c'
devf) = d -> (c', Needle d +> Needle c', LinDevPropag d c')
f d
d
                                (c''
c'',Needle d +> Needle c''
jg, LinDevPropag d c''
devg) = d -> (c'', Needle d +> Needle c'', LinDevPropag d c'')
g d
d
                                (c
c, (v', v'') +> v
jh, ε -> (ε', ε'')
devh) = c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb c'
c' c''
c''
                                jhl :: LinearMap s v' v
jhl = (v', v'') +> v
jh 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 κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
idforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall v. AdditiveGroup v => v
zeroV); jhr :: LinearMap s v'' v
jhr = (v', v'') +> v
jh 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 v. AdditiveGroup v => v
zeroVforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
                            in ( c
c
                               , (v', v'') +> v
jh 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 d +> Needle c'
jfforall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&Needle d +> Needle c''
jg
                               , \ε
εc -> let εc' :: Norm v'
εc' = forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s v' v
jhl ε
εc
                                            εc'' :: Norm v''
εc'' = forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s v'' v
jhr ε
εc
                                            (ε'
δc',ε''
δc'') = ε -> (ε', ε'')
devh ε
εc 
                                        in LinDevPropag d c'
devf Norm v'
εc' forall a. Semigroup a => a -> a -> a
<> LinDevPropag d c''
devg Norm v''
εc''
                                             forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm Needle d +> Needle c'
jf ε'
δc'
                                             forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm Needle d +> Needle c''
jg ε''
δc''
                               )
                      (Maybe (Differentiable s d c'), Maybe (Differentiable s d c''))
_ -> forall s d c. Maybe (Differentiable s d c)
notDefinedHere
grwDfblFnValsCombine c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb RWDfblFuncValue s d c'
fv RWDfblFuncValue s d c''
gv
        = forall d c c' c'' v v' v'' ε ε' ε'' s.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c', Object (Differentiable s) c',
 Object (Differentiable s) c'', v ~ Needle c, v' ~ Needle c',
 v'' ~ Needle c'', SimpleSpace v, ε ~ Norm v, ε' ~ Norm v',
 ε'' ~ Norm v'', ε ~ ε', ε ~ ε'') =>
(c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε'')))
-> RWDfblFuncValue s d c'
-> RWDfblFuncValue s d c''
-> RWDfblFuncValue s d c
grwDfblFnValsCombine c' -> c'' -> (c, (v', v'') +> v, ε -> (ε', ε''))
cmb (forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue s d c'
fv) (forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue s d c''
gv)

          
rwDfbl_plus :: ∀ a v s .
        ( RealDimension s
        , Object (Differentiable s) a, Object (Differentiable s) v
        , LinearSpace v )
      => RWDiffable s a v -> RWDiffable s a v -> RWDiffable s a v
rwDfbl_plus :: forall a v s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) v, LinearSpace v) =>
RWDiffable s a v -> RWDiffable s a v -> RWDiffable s a v
rwDfbl_plus (RWDiffable a -> (PreRegion s a, Maybe (Differentiable s a v))
f) (RWDiffable a -> (PreRegion s a, Maybe (Differentiable s a v))
g) = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable
              forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @a (forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a (
                   ((SemimanifoldWithBoundary (Needle a),
  SemimanifoldWithBoundary (Needle (Needle a)),
  Semimanifold (Needle a), LinearSpace (Needle (Needle a)),
  SemimanifoldWithBoundary (Scalar (Needle (Needle a))),
  Interior (Needle a) ~ Needle a, Empty (Boundary (Needle a))),
 ProjectableBoundary (Needle a)) =>
LinearManifoldWitness v
-> LinearManifoldWitness (Needle a)
-> DualSpaceWitness v
-> DualSpaceWitness (Needle a)
-> a
-> (PreRegion s a, Maybe (Differentiable s a v))
h forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness
                        forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness))
   where h :: (OpenManifold (Needle a), ProjectableBoundary (Needle a))
               => LinearManifoldWitness v -> LinearManifoldWitness (Needle a)
               -> DualSpaceWitness v -> DualSpaceWitness (Needle a)
                -> a -> (PreRegion s a, Maybe (Differentiable s a v))
         h :: ((SemimanifoldWithBoundary (Needle a),
  SemimanifoldWithBoundary (Needle (Needle a)),
  Semimanifold (Needle a), LinearSpace (Needle (Needle a)),
  SemimanifoldWithBoundary (Scalar (Needle (Needle a))),
  Interior (Needle a) ~ Needle a, Empty (Boundary (Needle a))),
 ProjectableBoundary (Needle a)) =>
LinearManifoldWitness v
-> LinearManifoldWitness (Needle a)
-> DualSpaceWitness v
-> DualSpaceWitness (Needle a)
-> a
-> (PreRegion s a, Maybe (Differentiable s a v))
h LinearManifoldWitness v
LinearManifoldWitness LinearManifoldWitness (Needle a)
LinearManifoldWitness DualSpaceWitness v
DualSpaceWitness DualSpaceWitness (Needle a)
DualSpaceWitness
           a
x₀ = (PreRegion s a
rh, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) c b a.
(Applicative f r t, Object r c, ObjectMorphism r b c,
 Object t (f c), ObjectMorphism t (f b) (f c), ObjectPair r a b,
 ObjectPair t (f a) (f b)) =>
r a (r b c) -> t (f a) (t (f b) (f c))
liftA2 Differentiable s a v
-> Differentiable s a v -> Differentiable s a v
fgplus Maybe (Differentiable s a v)
ff Maybe (Differentiable s a v)
gf)
          where (PreRegion s a
rf, Maybe (Differentiable s a v)
ff) = a -> (PreRegion s a, Maybe (Differentiable s a v))
f a
x₀
                (PreRegion s a
rg, Maybe (Differentiable s a v)
gf) = a -> (PreRegion s a, Maybe (Differentiable s a v))
g a
x₀
                rh :: PreRegion s a
rh = forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion s a
rf PreRegion s a
rg
                fgplus :: Differentiable s a v -> Differentiable s a v -> Differentiable s a v
                fgplus :: Differentiable s a v
-> Differentiable s a v -> Differentiable s a v
fgplus (Differentiable a -> (v, Needle a +> Needle v, LinDevPropag a v)
fd) (Differentiable a -> (v, Needle a +> Needle v, LinDevPropag a v)
gd) = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd
                 where hd :: a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd a
x = (v
fxforall v. AdditiveGroup v => v -> v -> v
^+^v
gx, Needle a +> Needle v
jfforall v. AdditiveGroup v => v -> v -> v
^+^Needle a +> Needle v
jg, \Norm v
ε -> LinDevPropag a v
δf(forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm s
2 Norm v
ε)
                                                     forall a. Semigroup a => a -> a -> a
<> LinDevPropag a v
δg(forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm s
2 Norm v
ε))
                        where (v
fx, Needle a +> Needle v
jf, LinDevPropag a v
δf) = a -> (v, Needle a +> Needle v, LinDevPropag a v)
fd a
x
                              (v
gx, Needle a +> Needle v
jg, LinDevPropag a v
δg) = a -> (v, Needle a +> Needle v, LinDevPropag a v)
gd a
x
                fgplus (Differentiable a -> (v, Needle a +> Needle v, LinDevPropag a v)
fd) (AffinDiffable DiffableEndoProof a v
_ Affine s a v
ga)
                                 = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd
                 where hd :: a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd a
x = (v
fxforall v. AdditiveGroup v => v -> v -> v
^+^v
gx, Needle a +> Needle v
jfforall v. AdditiveGroup v => v -> v -> v
^+^LinearMap s (Needle a) (Needle v)
ϕg, LinDevPropag a v
δf)
                        where (v
fx, Needle a +> Needle v
jf, LinDevPropag a v
δf) = a -> (v, Needle a +> Needle v, LinDevPropag a v)
fd a
x
                              (v
gx, LinearMap s (Needle a) (Needle v)
ϕg) = forall x y s.
(Manifold x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar (Needle x), s ~ Scalar (Needle y)) =>
Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine Affine s a v
ga a
x
                fgplus (AffinDiffable DiffableEndoProof a v
_ Affine s a v
fa) (Differentiable a -> (v, Needle a +> Needle v, LinDevPropag a v)
gd)
                                 = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd
                 where hd :: a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd a
x = (v
fxforall v. AdditiveGroup v => v -> v -> v
^+^v
gx, LinearMap s (Needle a) (Needle v)
ϕfforall v. AdditiveGroup v => v -> v -> v
^+^Needle a +> Needle v
jg, LinDevPropag a v
δg)
                        where (v
gx, Needle a +> Needle v
jg, LinDevPropag a v
δg) = a -> (v, Needle a +> Needle v, LinDevPropag a v)
gd a
x
                              (v
fx, LinearMap s (Needle a) (Needle v)
ϕf) = forall x y s.
(Manifold x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar (Needle x), s ~ Scalar (Needle y)) =>
Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine Affine s a v
fa a
x
                fgplus (AffinDiffable DiffableEndoProof a v
fe Affine s a v
fa) (AffinDiffable DiffableEndoProof a v
ge Affine s a v
ga)
                           = forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable (DiffableEndoProof a v
feforall a. Semigroup a => a -> a -> a
<>DiffableEndoProof a v
ge) (Affine s a v
faforall v. AdditiveGroup v => v -> v -> v
^+^Affine s a v
ga)

rwDfbl_negateV :: ∀ a v s .
        ( WithField s Manifold a
        , LinearSpace v, Scalar v ~ s
        , RealDimension s )
      => RWDiffable s a v -> RWDiffable s a v
rwDfbl_negateV :: forall a v s.
(WithField s Manifold a, LinearSpace v, Scalar v ~ s,
 RealDimension s) =>
RWDiffable s a v -> RWDiffable s a v
rwDfbl_negateV (RWDiffable a -> (PreRegion s a, Maybe (Differentiable s a v))
f) = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable
           forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @a (forall m r.
ProjectableBoundary m =>
(ProjectableBoundary (Needle (Interior m)) => r) -> r
needleBoundaryIsTriviallyProjectible @a (
                  ((SemimanifoldWithBoundary (Needle a),
  SemimanifoldWithBoundary (Needle (Needle a)),
  Semimanifold (Needle a), LinearSpace (Needle (Needle a)),
  SemimanifoldWithBoundary (Scalar (Needle (Needle a))),
  Interior (Needle a) ~ Needle a, Empty (Boundary (Needle a))),
 ProjectableBoundary (Needle a)) =>
LinearManifoldWitness v
-> DualSpaceWitness v
-> LinearManifoldWitness (Needle a)
-> DualSpaceWitness (Needle a)
-> a
-> (PreRegion s a, Maybe (Differentiable s a v))
h forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
                    forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness))
   where h :: (OpenManifold (Needle a), ProjectableBoundary (Needle a))
             => LinearManifoldWitness v -> DualSpaceWitness v
              -> LinearManifoldWitness (Needle a) -> DualSpaceWitness (Needle a)
                -> a -> (PreRegion s a, Maybe (Differentiable s a v))
         h :: ((SemimanifoldWithBoundary (Needle a),
  SemimanifoldWithBoundary (Needle (Needle a)),
  Semimanifold (Needle a), LinearSpace (Needle (Needle a)),
  SemimanifoldWithBoundary (Scalar (Needle (Needle a))),
  Interior (Needle a) ~ Needle a, Empty (Boundary (Needle a))),
 ProjectableBoundary (Needle a)) =>
LinearManifoldWitness v
-> DualSpaceWitness v
-> LinearManifoldWitness (Needle a)
-> DualSpaceWitness (Needle a)
-> a
-> (PreRegion s a, Maybe (Differentiable s a v))
h LinearManifoldWitness v
LinearManifoldWitness DualSpaceWitness v
DualSpaceWitness LinearManifoldWitness (Needle a)
LinearManifoldWitness DualSpaceWitness (Needle a)
DualSpaceWitness
           a
x₀ = (PreRegion s a
rf, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Functor f r t, Object r a, Object t (f a), Object r b,
 Object t (f b)) =>
r a b -> t (f a) (f b)
fmap Differentiable s a v -> Differentiable s a v
fneg Maybe (Differentiable s a v)
ff)
          where (PreRegion s a
rf, Maybe (Differentiable s a v)
ff) = a -> (PreRegion s a, Maybe (Differentiable s a v))
f a
x₀
                fneg :: Differentiable s a v -> Differentiable s a v
                fneg :: Differentiable s a v -> Differentiable s a v
fneg (Differentiable a -> (v, Needle a +> Needle v, LinDevPropag a v)
fd) = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd
                 where hd :: a -> (v, LinearMap s (Needle a) v, Norm v -> Norm (Needle a))
hd a
x = (forall v. AdditiveGroup v => v -> v
negateV v
fx, forall v. AdditiveGroup v => v -> v
negateV Needle a +> Needle v
jf, LinDevPropag a v
δf)
                        where (v
fx, Needle a +> Needle v
jf, LinDevPropag a v
δf) = a -> (v, Needle a +> Needle v, LinDevPropag a v)
fd a
x
                fneg (AffinDiffable DiffableEndoProof a v
ef Affine s a v
af) = forall s d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable DiffableEndoProof a v
ef forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. AdditiveGroup v => v -> v
negateV Affine s a v
af

postCompRW :: ∀ a b c s . ( RealDimension s
                          , Object (Differentiable s) a
                          , Object (Differentiable s) b
                          , Object (Differentiable s) c )
              => RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW :: forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW (RWDiffable b -> (PreRegion s b, Maybe (Differentiable s b c))
f) (ConstRWDFV b
x) = case b -> (PreRegion s b, Maybe (Differentiable s b c))
f b
x of
     (PreRegion s b
_, Just Differentiable s b c
fd) -> forall c s d. c -> RWDfblFuncValue s d c
ConstRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Differentiable s b c
fd forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ b
x
postCompRW RWDiffable s b c
f RWDfblFuncValue s a b
RWDFV_IdVar = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV RWDiffable s b c
f
postCompRW RWDiffable s b c
f (GenericRWDFV RWDiffable s a b
g) = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ RWDiffable s b c
f 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
. RWDiffable s a b
g


instance ∀ s a v . ( RealDimension s
                   , Object (Differentiable s) a, Object (Differentiable s) v
                   , LinearSpace v )
    => AdditiveGroup (RWDfblFuncValue s a v) where
  zeroV :: RWDfblFuncValue s a v
zeroV = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness v
               , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
      (LinearManifoldWitness v
LinearManifoldWitness, DualSpaceWitness v
DualSpaceWitness) -> forall (p :: * -> * -> *) (k :: * -> * -> *) a x.
(PointAgent p k a x, Object k a, Object k x) =>
x -> p a x
point forall v. AdditiveGroup v => v
zeroV
  ^+^ :: RWDfblFuncValue s a v
-> RWDfblFuncValue s a v -> RWDfblFuncValue s a v
(^+^) = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness v
               , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
      (LinearManifoldWitness v
LinearManifoldWitness, DualSpaceWitness v
DualSpaceWitness)
         -> forall (k :: * -> * -> *) a b c.
(Curry k, ObjectPair k a b, ObjectMorphism k b c) =>
k (a, b) c -> k a (k b c)
curry forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \case
              (ConstRWDFV v
c₁, ConstRWDFV v
c₂) -> forall c s d. c -> RWDfblFuncValue s d c
ConstRWDFV (v
c₁forall v. AdditiveGroup v => v -> v -> v
^+^v
c₂)
              (ConstRWDFV v
c₁, RWDfblFuncValue s a v
RWDFV_IdVar) -> forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                               forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo v
c₁ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
              (RWDfblFuncValue s a v
RWDFV_IdVar, ConstRWDFV v
c₂) -> forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                               forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo v
c₂ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
              (ConstRWDFV v
c₁, GenericRWDFV RWDiffable s a v
g) -> forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                               forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo v
c₁ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) 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
. RWDiffable s a v
g
              (GenericRWDFV RWDiffable s a v
f, ConstRWDFV v
c₂) -> forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                                  forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo v
c₂ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) 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
. RWDiffable s a v
f
              (RWDfblFuncValue s a v
fa, RWDfblFuncValue s a v
ga) | GenericRWDFV RWDiffable s a v
f <- forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue s a v
fa
                       , GenericRWDFV RWDiffable s a v
g <- forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue s a v
ga
                                -> forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a v s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) v, LinearSpace v) =>
RWDiffable s a v -> RWDiffable s a v -> RWDiffable s a v
rwDfbl_plus RWDiffable s a v
f RWDiffable s a v
g
  negateV :: RWDfblFuncValue s a v -> RWDfblFuncValue s a v
negateV = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness v
                 , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness v ) of
      (LinearManifoldWitness v
LinearManifoldWitness, DualSpaceWitness v
DualSpaceWitness) -> \case
        (ConstRWDFV v
c) -> forall c s d. c -> RWDfblFuncValue s d c
ConstRWDFV (forall v. AdditiveGroup v => v -> v
negateV v
c)
        RWDfblFuncValue s a v
RWDFV_IdVar -> forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. AdditiveGroup v => v -> v
negateV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
        (GenericRWDFV RWDiffable s a v
f) -> forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a v s.
(WithField s Manifold a, LinearSpace v, Scalar v ~ s,
 RealDimension s) =>
RWDiffable s a v -> RWDiffable s a v
rwDfbl_negateV RWDiffable s a v
f

dualCoCoProduct :: ∀ v w s .
                   ( SimpleSpace v, HilbertSpace v
                   , SimpleSpace w, Scalar v ~ s, Scalar w ~ s )
           => LinearMap s w v -> LinearMap s w v -> Norm w
dualCoCoProduct :: forall v w s.
(SimpleSpace v, HilbertSpace v, SimpleSpace w, Scalar v ~ s,
 Scalar w ~ s) =>
LinearMap s w v -> LinearMap s w v -> Norm w
dualCoCoProduct = DualSpaceWitness w -> LinearMap s w v -> LinearMap s w v -> Norm w
dccp (forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness::DualSpaceWitness w)
 where dccp :: DualSpaceWitness w -> LinearMap s w v -> LinearMap s w v -> Norm w
dccp DualSpaceWitness w
DualSpaceWitness LinearMap s w v
s LinearMap s w v
t = forall v. (v -+> DualVector v) -> Norm v
Norm forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (s
tSpreadforall a. Num a => a -> a -> a
*s
sSpread) forall v. VectorSpace v => Scalar v -> v -> v
*^ w -+> DualVector w
t²Ps²M
        where t' :: LinearMap s v (DualVector w)
t' = forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap s w v
t :: LinearMap s v (DualVector w)
              s' :: LinearMap s v (DualVector w)
s' = forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap s w v
s :: LinearMap s v (DualVector w)
              tSpread :: s
tSpread = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum 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 a b. (a -> b) -> [a] -> [b]
map DualVector w -> s
recip_t²PLUSs² forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd (forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap LinearMap s v (DualVector w)
t') []
              sSpread :: s
sSpread = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum 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 a b. (a -> b) -> [a] -> [b]
map DualVector w -> s
recip_t²PLUSs² forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd (forall v w.
(FiniteDimensional v, LSpace w, Scalar w ~ Scalar v) =>
(v +> w) -> (SubBasis v, DList w)
decomposeLinMap LinearMap s v (DualVector w)
s') []
              t²PLUSs²' :: Norm w
t²PLUSs²'@(Norm w -+> DualVector w
t²Ps²M)
                = forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s w v
t forall v. HilbertSpace v => Norm v
euclideanNorm forall a. Semigroup a => a -> a -> a
<> forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s w v
s forall v. HilbertSpace v => Norm v
euclideanNorm :: Norm w
              recip_t²PLUSs² :: DualVector w -> s
recip_t²PLUSs² = forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq (forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Norm w
t²PLUSs²') :: DualVector w -> s

instance ∀ n a . ( RealDimension n, Object (Differentiable n) a, SimpleSpace (Needle a) )
            => Num (RWDfblFuncValue n a n) where
  fromInteger :: Integer -> RWDfblFuncValue n a n
fromInteger Integer
i = forall (p :: * -> * -> *) (k :: * -> * -> *) a x.
(PointAgent p k a x, Object k a, Object k x) =>
x -> p a x
point forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
i
  + :: RWDfblFuncValue n a n
-> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
(+) = forall v. AdditiveGroup v => v -> v -> v
(^+^)
  ConstRWDFV n
c₁ * :: RWDfblFuncValue n a n
-> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
* ConstRWDFV n
c₂ = forall c s d. c -> RWDfblFuncValue s d c
ConstRWDFV (n
c₁forall a. Num a => a -> a -> a
*n
c₂)
  ConstRWDFV n
c₁ * RWDfblFuncValue n a n
RWDFV_IdVar = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                               forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo 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 (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 (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
c₁)
  RWDfblFuncValue n a n
RWDFV_IdVar * ConstRWDFV n
c₂ = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                               forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo 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 (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 (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
c₂)
  ConstRWDFV n
c₁ * GenericRWDFV RWDiffable n a n
g = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                               forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo 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 (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 (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
c₁) 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
. RWDiffable n a n
g
  GenericRWDFV RWDiffable n a n
f * ConstRWDFV n
c₂ = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                               forall s a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo 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 (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 (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
c₂) 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
. RWDiffable n a n
f
  RWDfblFuncValue n a n
f*RWDfblFuncValue n a n
g = forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue n a n
f RWDfblFuncValue n a n
-> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
⋅ forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue n a n
g
   where (⋅) :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n -> RWDfblFuncValue n a n 
         GenericRWDFV (RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a n))
fpcs) ⋅ :: RWDfblFuncValue n a n
-> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
⋅ GenericRWDFV (RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a n))
gpcs)
           = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
               \a
d₀ -> let (PreRegion n a
rc₁, Maybe (Differentiable n a n)
fmay) = a -> (PreRegion n a, Maybe (Differentiable n a n))
fpcs a
d₀
                          (PreRegion n a
rc₂,Maybe (Differentiable n a n)
gmay) = a -> (PreRegion n a, Maybe (Differentiable n a n))
gpcs a
d₀
                      in (forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion n a
rc₁ PreRegion n a
rc₂, Differentiable n a n
-> Differentiable n a n -> Differentiable n a n
mulDi forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Maybe (Differentiable n a n)
fmay 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 (Differentiable n a n)
gmay)
          where mulDi :: Differentiable n a n -> Differentiable n a n -> Differentiable n a n
                mulDi :: Differentiable n a n
-> Differentiable n a n -> Differentiable n a n
mulDi f :: Differentiable n a n
f@(AffinDiffable DiffableEndoProof a n
ef Affine n a n
af) g :: Differentiable n a n
g@(AffinDiffable DiffableEndoProof a n
eg Affine n a n
ag) = case DiffableEndoProof a n
efforall a. Semigroup a => a -> a -> a
<>DiffableEndoProof a n
eg of
                   DiffableEndoProof a n
IsDiffableEndo ->
                  {- let f' = lapply slf 1; g' = lapply slg 1
                     in case f'*g' of
                          0 -> AffinDiffableEndo $ const (aof*aog)
                          f'g' -> -} forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                           \a
d -> let (n
fd,LinearMap n (Needle a) (Needle n)
ϕf) = forall x y s.
(Manifold x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar (Needle x), s ~ Scalar (Needle y)) =>
Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine Affine n a n
af a
d
                                     (n
gd,LinearMap n (Needle a) (Needle n)
ϕg) = forall x y s.
(Manifold x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar (Needle x), s ~ Scalar (Needle y)) =>
Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine Affine n a n
ag a
d
                                     jf :: n
jf = LinearMap n (Needle a) (Needle n)
ϕf forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ a
1; jg :: n
jg = LinearMap n (Needle a) (Needle n)
ϕg forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ a
1
                                     invf'g' :: a
invf'g' = forall a. Fractional a => a -> a
recip forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
jfforall a. Num a => a -> a -> a
*n
jg
                                 in ( n
fdforall a. Num a => a -> a -> a
*n
gd
                                    , 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 (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
fdforall a. Num a => a -> a -> a
*n
jg forall a. Num a => a -> a -> a
+ n
gdforall a. Num a => a -> a -> a
*n
jf
                                    , forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ String
"*" forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Floating a => a -> a
sqrt 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 a. Num a => a -> a -> a
*a
invf'g') )
                   DiffableEndoProof a n
_ -> Differentiable n a n
-> Differentiable n a n -> Differentiable n a n
mulDi (forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable n a n
f) (forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable n a n
g)
                mulDi (Differentiable a -> (n, Needle a +> Needle n, LinDevPropag a n)
f) (Differentiable a -> (n, Needle a +> Needle n, LinDevPropag a n)
g)
                   = forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                       \a
d -> let (n
c₁, Needle a +> Needle n
jf, LinDevPropag a n
devf) = a -> (n, Needle a +> Needle n, LinDevPropag a n)
f a
d
                                 (n
c₂, Needle a +> Needle n
jg, LinDevPropag a n
devg) = a -> (n, Needle a +> Needle n, LinDevPropag a n)
g a
d
                                 c :: n
c = n
c₁forall a. Num a => a -> a -> a
*n
c₂; c₁² :: n
c₁² = n
c₁forall a. Num a => a -> Int -> a
^Int
2; c₂² :: n
c₂² = n
c₂forall a. Num a => a -> Int -> a
^Int
2
                                 h' :: LinearMap n (Needle a) n
h' = n
c₁forall v. VectorSpace v => Scalar v -> v -> v
*^Needle a +> Needle n
jg forall v. AdditiveGroup v => v -> v -> v
^+^ n
c₂forall v. VectorSpace v => Scalar v -> v -> v
*^Needle a +> Needle n
jf
                                 in ( n
c
                                    , LinearMap n (Needle a) n
h'
                                    , \Seminorm n
εc -> let rε :: Scalar n
rε = Seminorm n
εcforall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|n
1
                                                 c₁worst :: n
c₁worst = forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
c₁² forall a. Num a => a -> a -> a
+ forall a. Fractional a => a -> a
recip(n
1 forall a. Num a => a -> a -> a
+ n
c₂²forall a. Num a => a -> a -> a
*Scalar n
rεforall a. Num a => a -> Int -> a
^Int
2)
                                                 c₂worst :: n
c₂worst = forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ n
c₂² forall a. Num a => a -> a -> a
+ forall a. Fractional a => a -> a
recip(n
1 forall a. Num a => a -> a -> a
+ n
c₁²forall a. Num a => a -> a -> a
*Scalar n
rεforall a. Num a => a -> Int -> a
^Int
2)
                                             in forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm (n
2forall a. Num a => a -> a -> a
*Scalar n
rε) (forall v w s.
(SimpleSpace v, HilbertSpace v, SimpleSpace w, Scalar v ~ s,
 Scalar w ~ s) =>
LinearMap s w v -> LinearMap s w v -> Norm w
dualCoCoProduct Needle a +> Needle n
jf Needle a +> Needle n
jg)
                                                forall a. Semigroup a => a -> a -> a
<> LinDevPropag a n
devf (forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm (n
2forall a. Num a => a -> a -> a
*n
c₂worst) Seminorm n
εc)
                                                forall a. Semigroup a => a -> a -> a
<> LinDevPropag a n
devg (forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm (n
2forall a. Num a => a -> a -> a
*n
c₁worst) Seminorm n
εc)
                    -- TODO: add formal proof for this (or, if necessary, the correct form)
                                        )
                mulDi Differentiable n a n
f Differentiable n a n
g = Differentiable n a n
-> Differentiable n a n -> Differentiable n a n
mulDi (forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable n a n
f) (forall s d c.
(LocallyScalable s d, LocallyScalable s c) =>
Differentiable s d c -> Differentiable s d c
genericiseDifferentiable Differentiable n a n
g)
                
  negate :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
negate = forall v. AdditiveGroup v => v -> v
negateV
  abs :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
abs = (forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable n -> (PreRegion n n, Maybe (Differentiable n n n))
absPW forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> AgentVal k a b -> AgentVal k a c
$~)
   where absPW :: n -> (PreRegion n n, Maybe (Differentiable n n n))
absPW n
a₀
          | n
a₀forall a. Ord a => a -> a -> Bool
<n
0       = (forall s. RealDimension s => PreRegion s s
negativePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Differentiable (Scalar (Needle n)) n n
desc)
          | Bool
otherwise  = (forall s. RealDimension s => PreRegion s s
positivePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Differentiable (Scalar (Needle n)) n n
asc)
         desc :: Differentiable (Scalar (Needle n)) n n
desc = forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v. AdditiveGroup v => v -> v
negateV forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
         asc :: Differentiable (Scalar (Needle n)) n n
asc = forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
(x +> x) -> Differentiable s x x
actuallyLinearEndo forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  signum :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
signum = (forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall {s} {a :: * -> * -> *} {b} {x} {f :: * -> *} {a}.
(Needle s ~ s, Interior s ~ s, Scalar s ~ s, DualVector s ~ s,
 Object a b, Object a x, PointObject a x, Applicative f,
 LinearSpace (Needle s), SemimanifoldWithBoundary (Needle s),
 SemimanifoldWithBoundary (Scalar (Needle s)), Empty (Boundary s),
 ProjectableBoundary s, FiniteDimensional s,
 FiniteDimensional (DualVector s), SemiInner s,
 SemiInner (DualVector s), Num' s, Num' (Scalar (Needle s)), IEEE s,
 IEEE (Scalar s), InnerSpace s, InnerSpace (Scalar s), Atlas s,
 HasTrie (ChartIndex s), WellPointed a, Num a, Num x, Ord a) =>
a -> (PreRegion s s, f (a b x))
sgnPW forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> AgentVal k a b -> AgentVal k a c
$~)
   where sgnPW :: a -> (PreRegion s s, f (a b x))
sgnPW a
a₀
          | a
a₀forall a. Ord a => a -> a -> Bool
<a
0       = (forall s. RealDimension s => PreRegion s s
negativePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ -x
1))
          | Bool
otherwise  = (forall s. RealDimension s => PreRegion s s
positivePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const x
1))

instance ∀ n a . ( RealDimension n, Object (Differentiable n) a, SimpleSpace (Needle a) )
            => Fractional (RWDfblFuncValue n a n) where
  fromRational :: Rational -> RWDfblFuncValue n a n
fromRational Rational
i = forall (p :: * -> * -> *) (k :: * -> * -> *) a x.
(PointAgent p k a x, Object k a, Object k x) =>
x -> p a x
point forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
i
  recip :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
recip = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
a₀ -> if n
a₀forall a. Ord a => a -> a -> Bool
<n
0
                                    then (forall s. RealDimension s => PreRegion s s
negativePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
negp))
                                    else (forall s. RealDimension s => PreRegion s s
positivePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
posp))
   where negp :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
negp Scalar (k a a)
x = (Scalar (k a a)
x'¹, (- Scalar (k a a)
x'¹forall a. Num a => a -> Int -> a
^Int
2) forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"1/"forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ)
                 -- ε = 1/x − δ/x² − 1/(x+δ)
                 -- ε·x + ε·δ = 1 + δ/x − δ/x − δ²/x² − 1
                 --           = -δ²/x²
                 -- 0 = δ² + ε·x²·δ + ε·x³
                 -- δ = let mph = -ε·x²/2 in mph + sqrt (mph² − ε·x³)
          where δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = let mph :: Scalar (k a a)
mph = -Scalar (k a a)
εforall a. Num a => a -> a -> a
*Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2forall a. Fractional a => a -> a -> a
/Scalar (k a a)
2
                          δ₀ :: Scalar (k a a)
δ₀ = Scalar (k a a)
mph forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sqrt (Scalar (k a a)
mphforall a. Num a => a -> Int -> a
^Int
2 forall a. Num a => a -> a -> a
- Scalar (k a a)
εforall a. Num a => a -> a -> a
*Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
3)
                      in if Scalar (k a a)
δ₀ forall a. Ord a => a -> a -> Bool
> Scalar (k a a)
0
                           then Scalar (k a a)
δ₀
                           else - Scalar (k a a)
x -- numerical underflow of εx³ vs mph
                                    --  ≡ ε*x^3 / (2*mph) (Taylor-expansion of the root)
                x'¹ :: Scalar (k a a)
x'¹ = forall a. Fractional a => a -> a
recip Scalar (k a a)
x
         posp :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
posp Scalar (k a a)
x = (Scalar (k a a)
x'¹, (- Scalar (k a a)
x'¹forall a. Num a => a -> Int -> a
^Int
2) forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"1/"forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ)
          where δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = let mph :: Scalar (k a a)
mph = Scalar (k a a)
εforall a. Num a => a -> a -> a
*Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2forall a. Fractional a => a -> a -> a
/Scalar (k a a)
2
                          δ₀ :: Scalar (k a a)
δ₀ = forall a. Floating a => a -> a
sqrt (Scalar (k a a)
mphforall a. Num a => a -> Int -> a
^Int
2 forall a. Num a => a -> a -> a
+ Scalar (k a a)
εforall a. Num a => a -> a -> a
*Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
3) forall a. Num a => a -> a -> a
- Scalar (k a a)
mph
                      in if Scalar (k a a)
δ₀forall a. Ord a => a -> a -> Bool
>Scalar (k a a)
0 then Scalar (k a a)
δ₀ else Scalar (k a a)
x
                x'¹ :: Scalar (k a a)
x'¹ = forall a. Fractional a => a -> a
recip Scalar (k a a)
x




instance ∀ n a . ( RealDimension n, Object (Differentiable n) a, SimpleSpace (Needle a) )
            => Floating (RWDfblFuncValue n a n) where
  pi :: RWDfblFuncValue n a n
pi = forall (p :: * -> * -> *) (k :: * -> * -> *) a x.
(PointAgent p k a x, Object k a, Object k x) =>
x -> p a x
point forall a. Floating a => a
pi
  
  exp :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
exp = forall s d c c' v v' ε.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c, Object (Differentiable s) c',
 v ~ Needle c, v' ~ Needle c', SimpleSpace v, ε ~ Norm v,
 ε ~ Norm v') =>
(c' -> (c, v' +> v, ε -> ε))
-> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c
grwDfblFnValsFunc
    forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x -> let ex :: n
ex = forall a. Floating a => a -> a
exp n
x
            in if n
exforall a. Num a => a -> a -> a
*n
2 forall a. Eq a => a -> a -> Bool
== n
ex  -- numerical trouble...
                then if n
xforall a. Ord a => a -> a -> Bool
<n
0 then ( n
0, forall v. AdditiveGroup v => v
zeroV, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"exp "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ n
x) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
ε -> forall a. Floating a => a -> a
log n
ε forall a. Num a => a -> a -> a
- n
x )
                            else ( n
ex, n
exforall v. VectorSpace v => Scalar v -> v -> v
*^forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
                                 , forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"exp "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ n
x) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
_ -> n
1e-300 :: n )
                else ( n
ex, n
ex forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"exp "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ n
x)
                          forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
ε -> case forall a. Floating a => a -> a
acosh(n
εforall a. Fractional a => a -> a -> a
/(n
2forall a. Num a => a -> a -> a
*n
ex) forall a. Num a => a -> a -> a
+ n
1) of
                                    n
δ | n
δforall a. Eq a => a -> a -> Bool
==n
δ      -> n
δ
                                      | Bool
otherwise -> forall a. Floating a => a -> a
log n
ε forall a. Num a => a -> a -> a
- n
x )
                 -- ε = e^(x+δ) − eˣ − eˣ·δ 
                 --   = eˣ·(e^δ − 1 − δ) 
                 --   ≤ eˣ · (e^δ − 1 + e^(-δ) − 1)
                 --   = eˣ · 2·(cosh(δ) − 1)
                 -- cosh(δ) ≥ ε/(2·eˣ) + 1
                 -- δ ≥ acosh(ε/(2·eˣ) + 1)
  log :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
log = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x -> if n
xforall a. Ord a => a -> a -> Bool
>n
0
                                  then (forall s. RealDimension s => PreRegion s s
positivePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
lnPosR))
                                  else (forall s. RealDimension s => PreRegion s s
negativePreRegion, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
   where lnPosR :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
lnPosR Scalar (k a a)
x = ( forall a. Floating a => a -> a
log Scalar (k a a)
x, forall a. Fractional a => a -> a
recip Scalar (k a a)
x forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"log "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Scalar (k a a)
ε -> Scalar (k a a)
x forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt(Scalar (k a a)
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
exp(-Scalar (k a a)
ε)) )
                 -- ε = ln x + (-δ)/x − ln(x−δ)
                 --   = ln (x / ((x−δ) · exp(δ/x)))
                 -- x/e^ε = (x−δ) · exp(δ/x)
                 -- let γ = δ/x ∈ [0,1[
                 -- exp(-ε) = (1−γ) · e^γ
                 --         ≥ (1−γ) · (1+γ)
                 --         = 1 − γ²
                 -- γ ≥ sqrt(1 − exp(-ε)) 
                 -- δ ≥ x · sqrt(1 − exp(-ε)) 
                    
  sqrt :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
sqrt = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x -> if n
xforall a. Ord a => a -> a -> Bool
>n
0
                                   then (forall s. RealDimension s => PreRegion s s
positivePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
sqrtPosR))
                                   else (forall s. RealDimension s => PreRegion s s
negativePreRegion, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
   where sqrtPosR :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
sqrtPosR Scalar (k a a)
x = ( Scalar (k a a)
sx, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (Scalar (k a a)
2forall a. Num a => a -> a -> a
*Scalar (k a a)
sx), forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"sqrt "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
                          \Scalar (k a a)
ε -> Scalar (k a a)
2 forall a. Num a => a -> a -> a
* (Scalar (k a a)
s2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt Scalar (k a a)
sxforall a. Num a => a -> Int -> a
^Int
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt Scalar (k a a)
ε forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
signum (Scalar (k a a)
εforall a. Num a => a -> a -> a
*Scalar (k a a)
2forall a. Num a => a -> a -> a
-Scalar (k a a)
sx) forall a. Num a => a -> a -> a
* Scalar (k a a)
sx forall a. Num a => a -> a -> a
* Scalar (k a a)
ε) )
          where sx :: Scalar (k a a)
sx = forall a. Floating a => a -> a
sqrt Scalar (k a a)
x; s2 :: Scalar (k a a)
s2 = forall a. Floating a => a -> a
sqrt Scalar (k a a)
2
                 -- Exact inverse of O(δ²) remainder.
  
  sin :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
sin = forall s d c c' v v' ε.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c, Object (Differentiable s) c',
 v ~ Needle c, v' ~ Needle c', SimpleSpace v, ε ~ Norm v,
 ε ~ Norm v') =>
(c' -> (c, v' +> v, ε -> ε))
-> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c
grwDfblFnValsFunc forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
sinDfb
   where sinDfb :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
sinDfb Scalar (k a a)
x = ( Scalar (k a a)
sx, Scalar (k a a)
cx forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"sin "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ )
          where sx :: Scalar (k a a)
sx = forall a. Floating a => a -> a
sin Scalar (k a a)
x; cx :: Scalar (k a a)
cx = forall a. Floating a => a -> a
cos Scalar (k a a)
x
                sx² :: Scalar (k a a)
sx² = Scalar (k a a)
sxforall a. Num a => a -> Int -> a
^Int
2; cx² :: Scalar (k a a)
cx² = Scalar (k a a)
cxforall a. Num a => a -> Int -> a
^Int
2
                sx' :: Scalar (k a a)
sx' = forall a. Num a => a -> a
abs Scalar (k a a)
sx; cx' :: Scalar (k a a)
cx' = forall a. Num a => a -> a
abs Scalar (k a a)
cx
                sx'³ :: Scalar (k a a)
sx'³ = Scalar (k a a)
sx'forall a. Num a => a -> a -> a
*Scalar (k a a)
sx²; cx⁴ :: Scalar (k a a)
cx⁴ = Scalar (k a a)
cx²forall a. Num a => a -> a -> a
*Scalar (k a a)
cx²
                δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = (Scalar (k a a)
εforall a. Num a => a -> a -> a
*(Scalar (k a a)
1.8 forall a. Num a => a -> a -> a
+ Scalar (k a a)
εforall a. Num a => a -> Int -> a
^Int
2forall a. Fractional a => a -> a -> a
/(Scalar (k a a)
cx' forall a. Num a => a -> a -> a
+ (Scalar (k a a)
2forall a. Num a => a -> a -> a
+Scalar (k a a)
40forall a. Num a => a -> a -> a
*Scalar (k a a)
cx⁴)forall a. Fractional a => a -> a -> a
/Scalar (k a a)
ε)) forall a. Num a => a -> a -> a
+ Scalar (k a a)
σ₃³forall a. Num a => a -> a -> a
*Scalar (k a a)
sx'³)forall a. Floating a => a -> a -> a
**(Scalar (k a a)
1forall a. Fractional a => a -> a -> a
/Scalar (k a a)
3) forall a. Num a => a -> a -> a
- Scalar (k a a)
σ₃forall a. Num a => a -> a -> a
*Scalar (k a a)
sx'
                        forall a. Num a => a -> a -> a
+ Scalar (k a a)
σ₂forall a. Num a => a -> a -> a
*forall a. Floating a => a -> a
sqrt Scalar (k a a)
εforall a. Fractional a => a -> a -> a
/(Scalar (k a a)
σ₂forall a. Num a => a -> a -> a
+Scalar (k a a)
cx²)
                    -- Carefully fine-tuned to give everywhere a good and safe bound.
                    -- The third root makes it pretty slow too, but since tight
                    -- deviation bounds can dramatically reduce the number of evaluations
                    -- needed in the first place, this is probably worthwhile.
                σ₂ :: Scalar (k a a)
σ₂ = Scalar (k a a)
1.4; σ₃ :: Scalar (k a a)
σ₃ = Scalar (k a a)
1.75; σ₃³ :: Scalar (k a a)
σ₃³ = Scalar (k a a)
σ₃forall a. Num a => a -> Int -> a
^Int
3
                    -- Safety margins for overlap between quadratic and cubic model
                    -- (these aren't naturally compatible to be used both together)
                      
  cos :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
cos = forall a. Floating a => a -> a
sin 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 a b. Differentiable s a b -> RWDiffable s a b
globalDiffable' (forall s x.
(Object (Affine s) x, Object (LinearMap s) x) =>
x -> (x +> Needle x) -> Differentiable s x x
actuallyAffineEndo (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/n
2) forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> AgentVal k a b -> AgentVal k a c
$~)
  
  sinh :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
sinh RWDfblFuncValue n a n
x = (forall a. Floating a => a -> a
exp RWDfblFuncValue n a n
x forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
exp (-RWDfblFuncValue n a n
x))forall a. Fractional a => a -> a -> a
/RWDfblFuncValue n a n
2
    {- = grwDfblFnValsFunc sinhDfb
   where sinhDfb x = ( sx, cx *^ idL, unsafe_dev_ε_δ δ )
          where sx = sinh x; cx = cosh x
                δ ε = undefined -}
                 -- ε = sinh x + δ · cosh x − sinh(x+δ)
                 --   = ½ · ( eˣ − e⁻ˣ + δ · (eˣ + e⁻ˣ) − exp(x+δ) + exp(-x−δ) )
                 --                  = ½·e⁻ˣ · ( e²ˣ − 1 + δ · (e²ˣ + 1) − e²ˣ·e^δ + e^-δ )
                 --   = ½ · ( eˣ − e⁻ˣ + δ · (eˣ + e⁻ˣ) − exp(x+δ) + exp(-x−δ) )
  cosh :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
cosh RWDfblFuncValue n a n
x = (forall a. Floating a => a -> a
exp RWDfblFuncValue n a n
x forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
exp (-RWDfblFuncValue n a n
x))forall a. Fractional a => a -> a -> a
/RWDfblFuncValue n a n
2
  
  tanh :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
tanh = forall s d c c' v v' ε.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c, Object (Differentiable s) c',
 v ~ Needle c, v' ~ Needle c', SimpleSpace v, ε ~ Norm v,
 ε ~ Norm v') =>
(c' -> (c, v' +> v, ε -> ε))
-> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c
grwDfblFnValsFunc forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
tanhDfb
   where tanhDfb :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
tanhDfb Scalar (k a a)
x = ( Scalar (k a a)
tnhx, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (forall a. Floating a => a -> a
cosh Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2), forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"tan "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ )
          where tnhx :: Scalar (k a a)
tnhx = forall a. Floating a => a -> a
tanh Scalar (k a a)
x
                c :: Scalar (k a a)
c = (Scalar (k a a)
tnhxforall a. Num a => a -> a -> a
*Scalar (k a a)
2forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi)forall a. Num a => a -> Int -> a
^Int
2
                p :: Scalar (k a a)
p = Scalar (k a a)
1 forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs Scalar (k a a)
xforall a. Fractional a => a -> a -> a
/(Scalar (k a a)
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)
                δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = Scalar (k a a)
p forall a. Num a => a -> a -> a
* (forall a. Floating a => a -> a
sqrt Scalar (k a a)
ε forall a. Num a => a -> a -> a
+ Scalar (k a a)
ε forall a. Num a => a -> a -> a
* Scalar (k a a)
c)
                  -- copied from 'atan' definition. Empirically works safely, in fact
                  -- with quite a big margin. TODO: find a tighter definition.

  atan :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
atan = forall s d c c' v v' ε.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c, Object (Differentiable s) c',
 v ~ Needle c, v' ~ Needle c', SimpleSpace v, ε ~ Norm v,
 ε ~ Norm v') =>
(c' -> (c, v' +> v, ε -> ε))
-> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c
grwDfblFnValsFunc forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
atanDfb
   where atanDfb :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
atanDfb Scalar (k a a)
x = ( Scalar (k a a)
atnx, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (Scalar (k a a)
1forall a. Num a => a -> a -> a
+Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2), forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"atan "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ )
          where atnx :: Scalar (k a a)
atnx = forall a. Floating a => a -> a
atan Scalar (k a a)
x
                c :: Scalar (k a a)
c = (Scalar (k a a)
atnxforall a. Num a => a -> a -> a
*Scalar (k a a)
2forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi)forall a. Num a => a -> Int -> a
^Int
2
                p :: Scalar (k a a)
p = Scalar (k a a)
1 forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
abs Scalar (k a a)
xforall a. Fractional a => a -> a -> a
/(Scalar (k a a)
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi)
                δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = Scalar (k a a)
p forall a. Num a => a -> a -> a
* (forall a. Floating a => a -> a
sqrt Scalar (k a a)
ε forall a. Num a => a -> a -> a
+ Scalar (k a a)
ε forall a. Num a => a -> a -> a
* Scalar (k a a)
c)
                 -- Semi-empirically obtained: with the epsEst helper,
                 -- it is observed that this function is (for xc≥0) a lower bound
                 -- to the arctangent. The growth of the p coefficient makes sense
                 -- and holds for arbitrarily large xc, because those move us linearly
                 -- away from the only place where the function is not virtually constant
                 -- (around 0).
   
  asin :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
asin = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x -> if
                  | n
x forall a. Ord a => a -> a -> Bool
< (-n
1)   -> (forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo (-n
1), forall s d c. Maybe (Differentiable s d c)
notDefinedHere)  
                  | n
x forall a. Ord a => a -> a -> Bool
> n
1      -> (forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom n
1, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
                  | Bool
otherwise  -> (forall s. RealDimension s => (s, s) -> PreRegion s s
intervalPreRegion (-n
1,n
1), forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
asinDefdR))
   where asinDefdR :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
asinDefdR Scalar (k a a)
x = ( Scalar (k a a)
asinx, Scalar (k a a)
asin'x forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"asin "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ )
          where asinx :: Scalar (k a a)
asinx = forall a. Floating a => a -> a
asin Scalar (k a a)
x; asin'x :: Scalar (k a a)
asin'x = forall a. Fractional a => a -> a
recip (forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Scalar (k a a)
1 forall a. Num a => a -> a -> a
- Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2)
                c :: Scalar (k a a)
c = Scalar (k a a)
1 forall a. Num a => a -> a -> a
- Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2 
                δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = forall a. Floating a => a -> a
sqrt Scalar (k a a)
ε forall a. Num a => a -> a -> a
* Scalar (k a a)
c
                 -- Empirical, with epsEst upper bound.

  acos :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
acos = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x -> if
                  | n
x forall a. Ord a => a -> a -> Bool
< (-n
1)   -> (forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo (-n
1), forall s d c. Maybe (Differentiable s d c)
notDefinedHere)  
                  | n
x forall a. Ord a => a -> a -> Bool
> n
1      -> (forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom n
1, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
                  | Bool
otherwise  -> (forall s. RealDimension s => (s, s) -> PreRegion s s
intervalPreRegion (-n
1,n
1), forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
acosDefdR))
   where acosDefdR :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
acosDefdR Scalar (k a a)
x = ( Scalar (k a a)
acosx, Scalar (k a a)
acos'x forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"acos "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ )
          where acosx :: Scalar (k a a)
acosx = forall a. Floating a => a -> a
acos Scalar (k a a)
x; acos'x :: Scalar (k a a)
acos'x = - forall a. Fractional a => a -> a
recip (forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Scalar (k a a)
1 forall a. Num a => a -> a -> a
- Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2)
                c :: Scalar (k a a)
c = Scalar (k a a)
1 forall a. Num a => a -> a -> a
- Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2
                δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = forall a. Floating a => a -> a
sqrt Scalar (k a a)
ε forall a. Num a => a -> a -> a
* Scalar (k a a)
c -- Like for asin – it's just a translation/reflection.

  asinh :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
asinh = forall s d c c' v v' ε.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c, Object (Differentiable s) c',
 v ~ Needle c, v' ~ Needle c', SimpleSpace v, ε ~ Norm v,
 ε ~ Norm v') =>
(c' -> (c, v' +> v, ε -> ε))
-> RWDfblFuncValue s d c' -> RWDfblFuncValue s d c
grwDfblFnValsFunc forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
asinhDfb
   where asinhDfb :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
asinhDfb Scalar (k a a)
x = ( Scalar (k a a)
asinhx, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ forall a. Floating a => a -> a
sqrt(Scalar (k a a)
1forall a. Num a => a -> a -> a
+Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2), forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"asinh "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ )
          where asinhx :: Scalar (k a a)
asinhx = forall a. Floating a => a -> a
asinh Scalar (k a a)
x
                δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = forall a. Num a => a -> a
abs Scalar (k a a)
x forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt((Scalar (k a a)
1 forall a. Num a => a -> a -> a
- forall a. Floating a => a -> a
exp(-Scalar (k a a)
ε))forall a. Num a => a -> a -> a
*Scalar (k a a)
0.8 forall a. Num a => a -> a -> a
+ Scalar (k a a)
εforall a. Num a => a -> Int -> a
^Int
2forall a. Fractional a => a -> a -> a
/(Scalar (k a a)
3forall a. Num a => a -> a -> a
*forall a. Num a => a -> a
abs Scalar (k a a)
x forall a. Num a => a -> a -> a
+ Scalar (k a a)
1)) forall a. Num a => a -> a -> a
+ forall a. Floating a => a -> a
sqrt(Scalar (k a a)
εforall a. Fractional a => a -> a -> a
/(forall a. Num a => a -> a
abs Scalar (k a a)
xforall a. Num a => a -> a -> a
+Scalar (k a a)
0.5))
                 -- Empirical, modified from log function (the area hyperbolic sine
                 -- resembles two logarithmic lobes), with epsEst-checked lower bound.
  
  acosh :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
acosh = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x -> if n
xforall a. Ord a => a -> a -> Bool
>n
1
                                   then (forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom n
1, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
acoshDfb))
                                   else (forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo n
1, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
   where acoshDfb :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
acoshDfb Scalar (k a a)
x = ( forall a. Floating a => a -> a
acosh Scalar (k a a)
x, forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ forall a. Floating a => a -> a
sqrt(Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2 forall a. Num a => a -> a -> a
- Scalar (k a a)
1), forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"acosh "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) Scalar (k a a) -> Scalar (k a a)
δ )
          where δ :: Scalar (k a a) -> Scalar (k a a)
δ Scalar (k a a)
ε = (Scalar (k a a)
2 forall a. Num a => a -> a -> a
- Scalar (k a a)
1forall a. Fractional a => a -> a -> a
/forall a. Floating a => a -> a
sqrt Scalar (k a a)
x) forall a. Num a => a -> a -> a
* (Scalar (k a a)
s2 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt Scalar (k a a)
sxforall a. Num a => a -> Int -> a
^Int
3 forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sqrt(Scalar (k a a)
εforall a. Fractional a => a -> a -> a
/Scalar (k a a)
s2) forall a. Num a => a -> a -> a
+ forall a. Num a => a -> a
signum (Scalar (k a a)
εforall a. Num a => a -> a -> a
*Scalar (k a a)
s2forall a. Num a => a -> a -> a
-Scalar (k a a)
sx) forall a. Num a => a -> a -> a
* Scalar (k a a)
sx forall a. Num a => a -> a -> a
* Scalar (k a a)
εforall a. Fractional a => a -> a -> a
/Scalar (k a a)
s2) 
                sx :: Scalar (k a a)
sx = forall a. Floating a => a -> a
sqrt(Scalar (k a a)
xforall a. Num a => a -> a -> a
-Scalar (k a a)
1)
                s2 :: Scalar (k a a)
s2 = forall a. Floating a => a -> a
sqrt Scalar (k a a)
2
                 -- Empirical, modified from sqrt function – the area hyperbolic cosine
                 -- strongly resembles \x -> sqrt(2 · (x-1)).
                    
  atanh :: RWDfblFuncValue n a n -> RWDfblFuncValue n a n
atanh = forall a b c s.
(RealDimension s, Object (Differentiable s) a,
 Object (Differentiable s) b, Object (Differentiable s) c) =>
RWDiffable s b c -> RWDfblFuncValue s a b -> RWDfblFuncValue s a c
postCompRW 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x -> if
                  | n
x forall a. Ord a => a -> a -> Bool
< (-n
1)   -> (forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo (-n
1), forall s d c. Maybe (Differentiable s d c)
notDefinedHere)  
                  | n
x forall a. Ord a => a -> a -> Bool
> n
1      -> (forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom n
1, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
                  | Bool
otherwise  -> (forall s. RealDimension s => (s, s) -> PreRegion s s
intervalPreRegion (-n
1,n
1), forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (forall d c s.
(d -> (c, Needle d +> Needle c, LinDevPropag d c))
-> Differentiable s d c
Differentiable forall {k :: * -> * -> *} {a}.
(Scalar (Scalar (k a a)) ~ Scalar (k a a),
 Interior (Scalar (k a a)) ~ Scalar (k a a),
 DualVector (Scalar (k a a)) ~ Scalar (k a a),
 Needle (Scalar (k a a)) ~ Scalar (k a a), Object k a, Category k,
 LinearSpace (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Needle (Scalar (k a a))),
 SemimanifoldWithBoundary (Scalar (Needle (Scalar (k a a)))),
 Empty (Boundary (Scalar (k a a))),
 ProjectableBoundary (Scalar (k a a)),
 FiniteDimensional (Scalar (k a a)),
 FiniteDimensional (DualVector (Scalar (k a a))),
 SemiInner (Scalar (k a a)),
 SemiInner (DualVector (Scalar (k a a))), Num' (Scalar (k a a)),
 Num' (Scalar (Needle (Scalar (k a a)))), VectorSpace (k a a),
 IEEE (Scalar (k a a)), IEEE (Scalar (Scalar (k a a))),
 InnerSpace (Scalar (k a a)), InnerSpace (Scalar (Scalar (k a a))),
 Atlas (Scalar (k a a)), HasTrie (ChartIndex (Scalar (k a a)))) =>
Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
atnhDefdR))
   where atnhDefdR :: Scalar (k a a)
-> (Scalar (k a a), k a a,
    Norm (Needle (Scalar (k a a))) -> Norm (Needle (Scalar (k a a))))
atnhDefdR Scalar (k a a)
x = ( forall a. Floating a => a -> a
atanh Scalar (k a a)
x, forall a. Fractional a => a -> a
recip(Scalar (k a a)
1forall a. Num a => a -> a -> a
-Scalar (k a a)
xforall a. Num a => a -> Int -> a
^Int
2) forall v. VectorSpace v => Scalar v -> v -> v
*^ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id, forall a. RealDimension a => String -> (a -> a) -> LinDevPropag a a
unsafe_dev_ε_δ(String
"atanh "forall a. [a] -> [a] -> [a]
++forall r. RealFloat r => r -> String
showℝ Scalar (k a a)
x) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Scalar (k a a)
ε -> forall a. Floating a => a -> a
sqrt(forall a. Floating a => a -> a
tanh Scalar (k a a)
ε)forall a. Num a => a -> a -> a
*(Scalar (k a a)
1forall a. Num a => a -> a -> a
-forall a. Num a => a -> a
abs Scalar (k a a)
x) )
                 -- Empirical, with epsEst upper bound.
  



-- $definitionRegionOps
-- Because the agents of 'RWDiffable' aren't really values in /Hask/, you can't use
-- the standard comparison operators on them, nor the built-in syntax of guards
-- or if-statements.
-- 
-- However, because this category allows functions to be undefined in some region,
-- such decisions can be faked quite well: '?->' restricts a function to
-- some region, by simply marking it undefined outside, and '?|:' replaces these
-- regions with values from another function.
-- 
-- Example: define a function that is compactly supported on the interval ]-1,1[,
-- i.e. exactly zero everywhere outside.
--
-- @
-- Graphics.Dynamic.Plot.R2> plotWindow [fnPlot (\\x -> -1 '?<' x '?<' 1 '?->' cos (x*pi/2)^2 '?|:' 0)]
-- @
-- 
-- <<images/examples/DiffableFunction-plots/Hann-window.png>>
-- 
-- Note that it may not be necessary to restrict explicitly: for instance if a
-- square root appears somewhere in an expression, then the expression is automatically
-- restricted so that the root has a positive argument!
-- 
-- @
-- Graphics.Dynamic.Plot.R2> plotWindow [fnPlot (\\x -> sqrt x '?|:' -sqrt (-x))]
-- @
-- 
-- <<images/examples/DiffableFunction-plots/safe-sqrt.png>>
  
infixr 4 ?->
-- | Require the LHS to be defined before considering the RHS as result.
--   This works analogously to the standard `Control.Applicative.Applicative` method
-- 
--   @
--   ('Control.Applicative.*>') :: Maybe a -> Maybe b -> Maybe b
--   Just _ 'Control.Applicative.*>' a = a
--   _      'Control.Applicative.*>' a = Nothing
--   @
(?->) :: ( RealDimension n, Object (Differentiable n) a, Object (Differentiable n) b
         , Object (Differentiable n) c )
      => RWDfblFuncValue n c a -> RWDfblFuncValue n c b -> RWDfblFuncValue n c b
ConstRWDFV a
_ ?-> :: forall n a b c.
(RealDimension n, Object (Differentiable n) a,
 Object (Differentiable n) b, Object (Differentiable n) c) =>
RWDfblFuncValue n c a
-> RWDfblFuncValue n c b -> RWDfblFuncValue n c b
?-> RWDfblFuncValue n c b
f = RWDfblFuncValue n c b
f
RWDfblFuncValue n c a
RWDFV_IdVar ?-> RWDfblFuncValue n c b
f = RWDfblFuncValue n c b
f
GenericRWDFV (RWDiffable c -> (PreRegion n c, Maybe (Differentiable n c a))
r) ?-> ConstRWDFV b
c = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV (forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable c -> (PreRegion n c, Maybe (Differentiable n c b))
s)
 where s :: c -> (PreRegion n c, Maybe (Differentiable n c b))
s c
x₀ = case c -> (PreRegion n c, Maybe (Differentiable n c a))
r c
x₀ of
                (PreRegion n c
rd, Just Differentiable n c a
q)  -> (PreRegion n c
rd, 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 (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const b
c)
                (PreRegion n c
rd, Maybe (Differentiable n c a)
Nothing) -> (PreRegion n c
rd, forall (f :: * -> *) a. Alternative f => f a
empty)
GenericRWDFV (RWDiffable c -> (PreRegion n c, Maybe (Differentiable n c a))
f) ?-> GenericRWDFV (RWDiffable c -> (PreRegion n c, Maybe (Differentiable n c b))
g) = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV (forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable c -> (PreRegion n c, Maybe (Differentiable n c b))
h)
 where h :: c -> (PreRegion n c, Maybe (Differentiable n c b))
h c
x₀ = case c -> (PreRegion n c, Maybe (Differentiable n c a))
f c
x₀ of
                (PreRegion n c
rf, Just Differentiable n c a
_) | (PreRegion n c
rg, Maybe (Differentiable n c b)
q) <- c -> (PreRegion n c, Maybe (Differentiable n c b))
g c
x₀
                        -> (forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion n c
rf PreRegion n c
rg, Maybe (Differentiable n c b)
q)
                (PreRegion n c
rf, Maybe (Differentiable n c a)
Nothing) -> (PreRegion n c
rf, forall (f :: * -> *) a. Alternative f => f a
empty)
RWDfblFuncValue n c a
c ?-> RWDfblFuncValue n c b
f = RWDfblFuncValue n c a
c forall n a b c.
(RealDimension n, Object (Differentiable n) a,
 Object (Differentiable n) b, Object (Differentiable n) c) =>
RWDfblFuncValue n c a
-> RWDfblFuncValue n c b -> RWDfblFuncValue n c b
?-> forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue n c b
f

positiveRegionalId :: RealDimension n => RWDiffable n n n
positiveRegionalId :: forall n. RealDimension n => RWDiffable n n n
positiveRegionalId = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \n
x₀ ->
       if n
x₀ forall a. Ord a => a -> a -> Bool
> n
0 then (forall s. RealDimension s => PreRegion s s
positivePreRegion, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure 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 d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d. DiffableEndoProof d d
IsDiffableEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
                 else (forall s. RealDimension s => PreRegion s s
negativePreRegion, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)

infixl 5 ?> , ?<
-- | Return the RHS, if it is less than the LHS.
--   (Really the purpose is just to compare the values, but returning one of them
--   allows chaining of comparison operators like in Python.)
--   Note that less-than comparison is <http://www.paultaylor.eu/ASD/ equivalent>
--   to less-or-equal comparison, because there is no such thing as equality.
(?>) :: ( RealDimension n, Object (Differentiable n) a, SimpleSpace (Needle a) )
           => RWDfblFuncValue n a n -> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
RWDfblFuncValue n a n
a ?> :: forall n a.
(RealDimension n, Object (Differentiable n) a,
 SimpleSpace (Needle a)) =>
RWDfblFuncValue n a n
-> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
?> RWDfblFuncValue n a n
b = (forall n. RealDimension n => RWDiffable n n n
positiveRegionalId forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> AgentVal k a b -> AgentVal k a c
$~ RWDfblFuncValue n a n
aforall a. Num a => a -> a -> a
-RWDfblFuncValue n a n
b) forall n a b c.
(RealDimension n, Object (Differentiable n) a,
 Object (Differentiable n) b, Object (Differentiable n) c) =>
RWDfblFuncValue n c a
-> RWDfblFuncValue n c b -> RWDfblFuncValue n c b
?-> RWDfblFuncValue n a n
b

-- | Return the RHS, if it is greater than the LHS.
(?<) :: ( RealDimension n, Object (Differentiable n) a, SimpleSpace (Needle a) )
           => RWDfblFuncValue n a n -> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
ConstRWDFV n
a ?< :: forall n a.
(RealDimension n, Object (Differentiable n) a,
 SimpleSpace (Needle a)) =>
RWDfblFuncValue n a n
-> RWDfblFuncValue n a n -> RWDfblFuncValue n a n
?< RWDfblFuncValue n a n
RWDFV_IdVar = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
       \n
x₀ -> if n
a forall a. Ord a => a -> a -> Bool
< n
x₀ then ( forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom n
a
                             , forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure 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 d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d. DiffableEndoProof d d
IsDiffableEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id)
                        else (forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo n
a, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
RWDfblFuncValue n a n
RWDFV_IdVar ?< ConstRWDFV n
a = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV 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 d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
       \n
x₀ -> if n
x₀ forall a. Ord a => a -> a -> Bool
< n
a then ( forall s. RealDimension s => s -> PreRegion s s
preRegionFromMinInfTo n
a
                             , forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure 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 d c.
(Object (Affine s) d, Object (Affine s) c) =>
DiffableEndoProof d c -> Affine s d c -> Differentiable s d c
AffinDiffable forall d. DiffableEndoProof d d
IsDiffableEndo forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const n
a)
                        else (forall s. RealDimension s => s -> PreRegion s s
preRegionToInfFrom n
a, forall s d c. Maybe (Differentiable s d c)
notDefinedHere)
RWDfblFuncValue n a n
a ?< RWDfblFuncValue n a n
b = (forall n. RealDimension n => RWDiffable n n n
positiveRegionalId forall (k :: * -> * -> *) a b c.
(HasAgent k, Object k a, Object k b, Object k c) =>
k b c -> AgentVal k a b -> AgentVal k a c
$~ RWDfblFuncValue n a n
bforall a. Num a => a -> a -> a
-RWDfblFuncValue n a n
a) forall n a b c.
(RealDimension n, Object (Differentiable n) a,
 Object (Differentiable n) b, Object (Differentiable n) c) =>
RWDfblFuncValue n c a
-> RWDfblFuncValue n c b -> RWDfblFuncValue n c b
?-> RWDfblFuncValue n a n
b

infixl 3 ?|:
-- | Try the LHS, if it is undefined use the RHS. This works analogously to
--   the standard `Control.Applicative.Alternative` method
-- 
--   @
--   ('Control.Applicative.<|>') :: Maybe a -> Maybe a -> Maybe a
--   Just x 'Control.Applicative.<|>' _ = Just x
--   _      'Control.Applicative.<|>' a = a
--   @
-- 
--  Basically a weaker and agent-ised version of 'backupRegions'.
(?|:) :: ( RealDimension n, Object (Differentiable n) a, Object (Differentiable n) b )
      => RWDfblFuncValue n a b -> RWDfblFuncValue n a b -> RWDfblFuncValue n a b
ConstRWDFV b
c ?|: :: forall n a b.
(RealDimension n, Object (Differentiable n) a,
 Object (Differentiable n) b) =>
RWDfblFuncValue n a b
-> RWDfblFuncValue n a b -> RWDfblFuncValue n a b
?|: RWDfblFuncValue n a b
_ = forall c s d. c -> RWDfblFuncValue s d c
ConstRWDFV b
c
RWDfblFuncValue n a b
RWDFV_IdVar ?|: RWDfblFuncValue n a b
_ = forall s c. RWDfblFuncValue s c c
RWDFV_IdVar
GenericRWDFV (RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
f) ?|: ConstRWDFV b
c = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV (forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
h)
 where h :: a -> (PreRegion n a, Maybe (Differentiable n a b))
h a
x₀ = case a -> (PreRegion n a, Maybe (Differentiable n a b))
f a
x₀ of
                (PreRegion n a
rd, Just Differentiable n a b
q) -> (PreRegion n a
rd, forall a. a -> Maybe a
Just Differentiable n a b
q)
                (PreRegion n a
rd, Maybe (Differentiable n a b)
Nothing) -> (PreRegion n a
rd, forall a. a -> Maybe a
Just forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const b
c)
GenericRWDFV (RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
f) ?|: GenericRWDFV (RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
g) = forall s d c. RWDiffable s d c -> RWDfblFuncValue s d c
GenericRWDFV (forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
h)
 where h :: a -> (PreRegion n a, Maybe (Differentiable n a b))
h a
x₀ = case a -> (PreRegion n a, Maybe (Differentiable n a b))
f a
x₀ of
                (PreRegion n a
rf, Just Differentiable n a b
q) -> (PreRegion n a
rf, forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Differentiable n a b
q)
                (PreRegion n a
rf, Maybe (Differentiable n a b)
Nothing) | (PreRegion n a
rg, Maybe (Differentiable n a b)
q) <- a -> (PreRegion n a, Maybe (Differentiable n a b))
g a
x₀
                        -> (forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion n a
rf PreRegion n a
rg, Maybe (Differentiable n a b)
q)
RWDfblFuncValue n a b
c ?|: RWDfblFuncValue n a b
f = RWDfblFuncValue n a b
c forall n a b.
(RealDimension n, Object (Differentiable n) a,
 Object (Differentiable n) b) =>
RWDfblFuncValue n a b
-> RWDfblFuncValue n a b -> RWDfblFuncValue n a b
?|: forall s d c.
(RealDimension s, Object (Differentiable s) d,
 Object (Differentiable s) c) =>
RWDfblFuncValue s d c -> RWDfblFuncValue s d c
genericiseRWDFV RWDfblFuncValue n a b
f

-- | Replace the regions in which the first function is undefined with values
--   from the second function.
backupRegions :: (RealDimension n, Object (Differentiable n) a, Object (Differentiable n) b)
      => RWDiffable n a b -> RWDiffable n a b -> RWDiffable n a b
backupRegions :: forall n a b.
(RealDimension n, Object (Differentiable n) a,
 Object (Differentiable n) b) =>
RWDiffable n a b -> RWDiffable n a b -> RWDiffable n a b
backupRegions (RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
f) (RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
g) = forall s d c.
(d -> (PreRegion s d, Maybe (Differentiable s d c)))
-> RWDiffable s d c
RWDiffable a -> (PreRegion n a, Maybe (Differentiable n a b))
h
 where h :: a -> (PreRegion n a, Maybe (Differentiable n a b))
h a
x₀ = case a -> (PreRegion n a, Maybe (Differentiable n a b))
f a
x₀ of
                (PreRegion n a
rf, q :: Maybe (Differentiable n a b)
q@(Just Differentiable n a b
_)) -> (PreRegion n a
rf, Maybe (Differentiable n a b)
q)
                (PreRegion n a
rf, Maybe (Differentiable n a b)
Nothing) | (PreRegion n a
rg, Maybe (Differentiable n a b)
q) <- a -> (PreRegion n a, Maybe (Differentiable n a b))
g a
x₀
                        -> (forall a s.
(RealFloat'' s, LocallyScalable s a, Manifold a, Atlas' a,
 Atlas' s, SimpleSpace (Needle a)) =>
PreRegion s a -> PreRegion s a -> PreRegion s a
unsafePreRegionIntersect PreRegion n a
rf PreRegion n a
rg, Maybe (Differentiable n a b)
q)





-- | Like 'Data.VectorSpace.lerp', but gives a differentiable function
--   instead of a Hask one.
lerp_diffable :: ∀ m s . ( LinearSpace m, RealDimension s, Object (Differentiable s) m )
      => m -> m -> Differentiable s s m
lerp_diffable :: forall m s.
(LinearSpace m, RealDimension s, Object (Differentiable s) m) =>
m -> m -> Differentiable s s m
lerp_diffable = case ( forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @m
                     , forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @m
                     , forall m. SemimanifoldWithBoundary m => SmfdWBoundWitness m
smfdWBoundWitness @m) of
     (LinearManifoldWitness m
LinearManifoldWitness, DualSpaceWitness m
DualSpaceWitness, SmfdWBoundWitness m
OpenManifoldWitness)
         -> \m
a m
b -> forall s x y.
(Object (Affine s) x, Object (Affine s) y, Object (LinearMap s) x,
 Object (LinearMap s) (Needle y)) =>
y -> (x +> Needle y) -> Differentiable s x y
actuallyAffine m
a 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 (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 (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall v w y. Bilinear v w y -> Bilinear w v y
flipBilin forall v. VectorSpace v => Bilinear (Scalar v) v v
scale forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ m
bforall p. AffineSpace p => p -> p -> Diff p
.-.m
a