{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ParallelListComp #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
module Data.Manifold.Shade (
Shade(..), pattern(:±), Shade'(..), (|±|), IsShade
, shadeCtr, shadeExpanse, shadeNarrowness
, fullShade, fullShade', pointsShades, pointsShade's
, pointsCovers, pointsCover's, coverAllAround
, occlusion, prettyShowsPrecShade', prettyShowShade', LtdErrorShow
, factoriseShade, orthoShades, (✠), intersectShade's, linIsoTransformShade
, embedShade, projectShade
, Refinable, subShade', refineShade', convolveShade', coerceShade
, mixShade's, dualShade, dualShade', wellDefinedShade', linearProjectShade
, shadesMerge, pointsShades', pseudoECM, convolveMetric
, WithAny(..), shadeWithAny, shadeWithoutAnything
, rangeWithinVertices
) where
import Data.List hiding (filter, all, elem, sum, foldr1)
import Data.Maybe
import Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NE
import Data.Semigroup
import Control.DeepSeq
import Data.MemoTrie
import Data.VectorSpace
import Data.AffineSpace
import Math.LinearMap.Category
import Data.Tagged
import Linear (_x,_y,_z,_w)
import Data.Manifold.Types
import Data.Manifold.Types.Primitive ((^))
import Data.Manifold.PseudoAffine
import Data.Manifold.Riemannian
import Data.Manifold.WithBoundary
import Data.Manifold.Atlas
import Data.Function.Affine
import Data.Manifold.Function.Quadratic
import Data.Embedding
import Control.Lens (Lens', (^.), view, _1, _2, mapping, (&))
import Control.Lens.TH
import qualified Prelude as Hask hiding(foldl, sum, sequence)
import qualified Control.Applicative as Hask
import qualified Data.Foldable as Hask
import Data.Foldable (all, elem, toList, sum, foldr1)
import Control.Category.Constrained.Prelude hiding
((^), all, elem, sum, forM, Foldable(..), foldr1, Traversable, traverse)
import Control.Arrow.Constrained
import Control.Monad.Constrained hiding (forM)
import GHC.Generics (Generic)
import Text.Show.Number
import qualified Text.Show.Pragmatic as SP
data Shade x where
Shade :: (Semimanifold x, SimpleSpace (Needle x))
=> { Shade x -> x
_shadeCtr :: !x
, Shade x -> Metric' x
_shadeExpanse :: !(Metric' x) } -> Shade x
deriving instance (Show x, Show (Metric' x), WithField ℝ PseudoAffine x)
=> Show (Shade x)
data Shade' x = Shade' { Shade' x -> x
_shade'Ctr :: !x
, Shade' x -> Metric x
_shade'Narrowness :: !(Metric x) }
class IsShade shade where
shadeCtr :: Lens' (shade x) x
occlusion :: ( PseudoAffine x, SimpleSpace (Needle x)
, s ~ (Scalar (Needle x)), RealFloat' s )
=> shade x -> x -> s
factoriseShade :: ( PseudoAffine x, SimpleSpace (Needle x)
, PseudoAffine y, SimpleSpace (Needle y)
, Scalar (Needle x) ~ Scalar (Needle y) )
=> shade (x,y) -> (shade x, shade y)
coerceShade :: ( Manifold x, Manifold y, LocallyCoercible x y
, SimpleSpace (Needle y) ) => shade x -> shade y
orthoShades :: ( PseudoAffine x, SimpleSpace (Needle x)
, PseudoAffine y, SimpleSpace (Needle y)
, Scalar (Needle x) ~ Scalar (Needle y) )
=> shade x -> shade y -> shade (x,y)
linIsoTransformShade :: ( SimpleSpace x, SimpleSpace y, Scalar x ~ Scalar y
, Num' (Scalar x) )
=> (x+>y) -> shade x -> shade y
projectShade :: ( Semimanifold x, Semimanifold y
, Object (Affine s) x, Object (Affine s) y
, SimpleSpace (Needle x), SemiInner (Needle y) )
=> Embedding (Affine s) x y
-> shade y -> shade x
embedShade :: ( Semimanifold x, Semimanifold y
, Object (Affine s) x, Object (Affine s) y
, SemiInner (Needle x), SimpleSpace (Needle y) )
=> Embedding (Affine s) x y
-> shade x -> shade y
linearProjectShade :: ∀ x y s
. (Num' s, LinearSpace x, SimpleSpace y, Scalar x ~ s, Scalar y ~ s)
=> (x+>y) -> Shade x -> Shade y
linearProjectShade :: (x +> y) -> Shade x -> Shade y
linearProjectShade = case ( LinearManifoldWitness x
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness x
, LinearManifoldWitness y
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness y
, DualSpaceWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness x
, DualSpaceWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness y ) of
( LinearManifoldWitness x
LinearManifoldWitness
,LinearManifoldWitness y
LinearManifoldWitness
,DualSpaceWitness x
DualSpaceWitness, DualSpaceWitness y
DualSpaceWitness )
-> \x +> y
f (Shade x
x Metric' x
ex) -> y -> Metric' y -> Shade y
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (LinearMap s x y
x +> y
f LinearMap s x y -> x -> y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x) ((x +> y) -> Variance x -> Variance y
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Variance v -> Variance w
transformVariance x +> y
f Variance x
Metric' x
ex)
infixl 5 ✠
(✠) :: ( IsShade shade, PseudoAffine x, SimpleSpace (Needle x)
, PseudoAffine y, SimpleSpace (Needle y)
, Scalar (Needle x) ~ Scalar (Needle y) )
=> shade x -> shade y -> shade (x,y)
✠ :: shade x -> shade y -> shade (x, y)
(✠) = shade x -> shade y -> shade (x, y)
forall (shade :: * -> *) x y.
(IsShade shade, PseudoAffine x, SimpleSpace (Needle x),
PseudoAffine y, SimpleSpace (Needle y),
Scalar (Needle x) ~ Scalar (Needle y)) =>
shade x -> shade y -> shade (x, y)
orthoShades
instance IsShade Shade where
shadeCtr :: (x -> f x) -> Shade x -> f (Shade x)
shadeCtr x -> f x
f (Shade x
c Metric' x
e) = (x -> Shade x) -> f x -> f (Shade x)
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 (x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
`Shade`Metric' x
e) (f x -> f (Shade x)) -> f x -> f (Shade x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x -> f x
f x
c
occlusion :: Shade x -> x -> s
occlusion = PseudoAffineWitness x -> DualNeedleWitness x -> Shade x -> x -> s
forall x s.
(PseudoAffine x, SimpleSpace (Needle x), Scalar (Needle x) ~ s,
RealFloat' s) =>
PseudoAffineWitness x -> DualNeedleWitness x -> Shade x -> x -> s
occ PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where occ :: ∀ x s . ( PseudoAffine x, SimpleSpace (Needle x)
, Scalar (Needle x) ~ s, RealFloat' s )
=> PseudoAffineWitness x -> DualNeedleWitness x -> Shade x -> x -> s
occ :: PseudoAffineWitness x -> DualNeedleWitness x -> Shade x -> x -> s
occ (PseudoAffineWitness SemimanifoldWitness x
SemimanifoldWitness) DualNeedleWitness x
DualSpaceWitness (Shade x
p₀ Metric' x
δ)
= \x
p -> case x
px -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
p₀ of
(Just Needle x
vd) | Scalar (Needle x)
mSq <- Seminorm (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Variance (DualVector (Needle x))
Seminorm (Needle x)
δinv Needle x
vd
, s
Scalar (Needle x)
mSq s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
Scalar (Needle x)
mSq
-> s -> s
forall a. Floating a => a -> a
exp (s -> s
forall a. Num a => a -> a
negate s
Scalar (Needle x)
mSq)
Maybe (Needle x)
_ -> s
forall v. AdditiveGroup v => v
zeroV
where δinv :: Variance (DualVector (Needle x))
δinv = Metric' x -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric' x
δ
factoriseShade :: Shade (x, y) -> (Shade x, Shade y)
factoriseShade = DualNeedleWitness x
-> DualNeedleWitness y -> Shade (x, y) -> (Shade x, Shade y)
forall x y.
(PseudoAffine x, SimpleSpace (Needle x), PseudoAffine y,
SimpleSpace (Needle y), Scalar (Needle x) ~ Scalar (Needle y)) =>
DualNeedleWitness x
-> DualNeedleWitness y -> Shade (x, y) -> (Shade x, Shade y)
fs DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualNeedleWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where fs :: ∀ x y . ( PseudoAffine x, SimpleSpace (Needle x)
, PseudoAffine y, SimpleSpace (Needle y)
, Scalar (Needle x) ~ Scalar (Needle y) )
=> DualNeedleWitness x -> DualNeedleWitness y
-> Shade (x,y) -> (Shade x, Shade y)
fs :: DualNeedleWitness x
-> DualNeedleWitness y -> Shade (x, y) -> (Shade x, Shade y)
fs DualNeedleWitness x
DualSpaceWitness DualNeedleWitness y
DualSpaceWitness (Shade (x
x₀,y
y₀) Metric' (x, y)
δxy)
= (x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
x₀ Metric' x
δx, y -> Metric' y -> Shade y
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade y
y₀ Metric' y
δy)
where (Metric' x
δx,Metric' y
δy) = Norm (DualVector (Needle x), DualVector (Needle y))
-> (Metric' x, Metric' y)
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms Norm (DualVector (Needle x), DualVector (Needle y))
Metric' (x, y)
δxy
orthoShades :: Shade x -> Shade y -> Shade (x, y)
orthoShades = DualNeedleWitness x
-> DualNeedleWitness y -> Shade x -> Shade y -> Shade (x, y)
forall x y.
(PseudoAffine x, SimpleSpace (Needle x), PseudoAffine y,
SimpleSpace (Needle y), Scalar (Needle x) ~ Scalar (Needle y)) =>
DualNeedleWitness x
-> DualNeedleWitness y -> Shade x -> Shade y -> Shade (x, y)
fs DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualNeedleWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where fs :: ∀ x y . ( PseudoAffine x, SimpleSpace (Needle x)
, PseudoAffine y, SimpleSpace (Needle y)
, Scalar (Needle x) ~ Scalar (Needle y) )
=> DualNeedleWitness x -> DualNeedleWitness y
-> Shade x -> Shade y -> Shade (x,y)
fs :: DualNeedleWitness x
-> DualNeedleWitness y -> Shade x -> Shade y -> Shade (x, y)
fs DualNeedleWitness x
DualSpaceWitness DualNeedleWitness y
DualSpaceWitness (Shade x
x Metric' x
δx) (Shade y
y Metric' y
δy)
= (x, y) -> Metric' (x, y) -> Shade (x, y)
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (x
x,y
y) (Norm (DualVector (Needle x), DualVector (Needle y))
-> Shade (x, y))
-> Norm (DualVector (Needle x), DualVector (Needle y))
-> Shade (x, y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric' x
-> Metric' y -> Norm (DualVector (Needle x), DualVector (Needle y))
forall u v.
(LSpace u, LSpace v, Scalar u ~ Scalar v) =>
Norm u -> Norm v -> Norm (u, v)
sumSubspaceNorms Metric' x
δx Metric' y
δy
coerceShade :: Shade x -> Shade y
coerceShade = DualNeedleWitness x -> DualNeedleWitness y -> Shade x -> Shade y
forall x y.
(LocallyCoercible x y, SimpleSpace (Needle y)) =>
DualNeedleWitness x -> DualNeedleWitness y -> Shade x -> Shade y
cS DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualNeedleWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where cS :: ∀ x y . (LocallyCoercible x y, SimpleSpace (Needle y))
=> DualNeedleWitness x -> DualNeedleWitness y -> Shade x -> Shade y
cS :: DualNeedleWitness x -> DualNeedleWitness y -> Shade x -> Shade y
cS DualNeedleWitness x
DualSpaceWitness DualNeedleWitness y
DualSpaceWitness
= \(Shade x
x Metric' x
δxym)
-> y -> Metric' y -> Shade y
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (x -> y
forall x ξ. LocallyCoercible x ξ => x -> ξ
locallyTrivialDiffeomorphism x
x) (Metric' x -> Metric' y
tN Metric' x
δxym)
where tN :: Metric' x -> Metric' y
tN = case CanonicalDiffeomorphism y x
forall x ξ. LocallyCoercible x ξ => CanonicalDiffeomorphism ξ x
oppositeLocalCoercion :: CanonicalDiffeomorphism y x of
CanonicalDiffeomorphism y x
CanonicalDiffeomorphism ->
LinearMap
(Scalar (DualVector (Needle y)))
(DualVector (Needle y))
(DualVector (Needle x))
-> Metric' x -> Metric' y
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm (LinearMap
(Scalar (DualVector (Needle y)))
(DualVector (Needle y))
(DualVector (Needle x))
-> Metric' x -> Metric' y)
-> (LinearFunction
(Scalar (Needle y)) (DualVector (Needle y)) (DualVector (Needle x))
-> LinearMap
(Scalar (DualVector (Needle y)))
(DualVector (Needle y))
(DualVector (Needle x)))
-> LinearFunction
(Scalar (Needle y)) (DualVector (Needle y)) (DualVector (Needle x))
-> Metric' x
-> Metric' y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearFunction
(Scalar (Needle y)) (DualVector (Needle y)) (DualVector (Needle x))
-> LinearMap
(Scalar (DualVector (Needle y)))
(DualVector (Needle y))
(DualVector (Needle x))
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (LinearFunction
(Scalar (Needle y)) (DualVector (Needle y)) (DualVector (Needle x))
-> Metric' x -> Metric' y)
-> LinearFunction
(Scalar (Needle y)) (DualVector (Needle y)) (DualVector (Needle x))
-> Metric' x
-> Metric' y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [(y, x)] -> DualVector (Needle y) -+> DualVector (Needle x)
forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle' x -+> Needle' ξ
coerceNeedle' ([]::[(y,x)])
linIsoTransformShade :: (x +> y) -> Shade x -> Shade y
linIsoTransformShade = LinearManifoldWitness x
-> LinearManifoldWitness y
-> DualSpaceWitness x
-> DualSpaceWitness y
-> (x +> y)
-> Shade x
-> Shade y
forall x y.
(LinearSpace x, SimpleSpace y, Scalar x ~ Scalar y,
Num' (Scalar x)) =>
LinearManifoldWitness x
-> LinearManifoldWitness y
-> DualSpaceWitness x
-> DualSpaceWitness y
-> (x +> y)
-> Shade x
-> Shade y
lits LinearManifoldWitness x
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness LinearManifoldWitness y
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness
DualSpaceWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where lits :: ∀ x y . ( LinearSpace x, SimpleSpace y
, Scalar x ~ Scalar y, Num' (Scalar x) )
=> LinearManifoldWitness x -> LinearManifoldWitness y
-> DualSpaceWitness x -> DualSpaceWitness y
-> (x+>y) -> Shade x -> Shade y
lits :: LinearManifoldWitness x
-> LinearManifoldWitness y
-> DualSpaceWitness x
-> DualSpaceWitness y
-> (x +> y)
-> Shade x
-> Shade y
lits (LinearManifoldWitness x
LinearManifoldWitness)
(LinearManifoldWitness y
LinearManifoldWitness)
DualSpaceWitness x
DualSpaceWitness DualSpaceWitness y
DualSpaceWitness
x +> y
f (Shade x
x Metric' x
δx)
= y -> Metric' y -> Shade y
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (x +> y
LinearMap (Scalar y) x y
f LinearMap (Scalar y) x y -> x -> y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x) ((DualVector y +> DualVector x)
-> Norm (DualVector x) -> Norm (DualVector y)
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm (LinearFunction
(Scalar (DualVector y))
(LinearMap (Scalar x) x (DualVector (DualVector y)))
(DualVector y +> DualVector x)
forall v w.
(LinearSpace v, LinearSpace w, Scalar v ~ Scalar w) =>
(v +> DualVector w) -+> (w +> DualVector v)
adjoint LinearFunction
(Scalar (DualVector y))
(LinearMap (Scalar x) x (DualVector (DualVector y)))
(DualVector y +> DualVector x)
-> LinearMap (Scalar x) x (DualVector (DualVector y))
-> DualVector y +> DualVector x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x +> y
LinearMap (Scalar x) x (DualVector (DualVector y))
f) Norm (DualVector x)
Metric' x
δx)
embedShade :: Embedding (Affine s) x y -> Shade x -> Shade y
embedShade = (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade x -> Shade y
forall s x y.
(Semimanifold y, Object (Affine s) x, Object (Affine s) y,
SemiInner (Needle x), SimpleSpace (Needle y)) =>
(SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade x -> Shade y
ps' (SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness, SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness)
where ps' :: ∀ s x y . ( Semimanifold y
, Object (Affine s) x, Object (Affine s) y
, SemiInner (Needle x), SimpleSpace (Needle y) )
=> (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y
-> Shade x -> Shade y
ps' :: (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade x -> Shade y
ps' (SemimanifoldWitness x
SemimanifoldWitness, SemimanifoldWitness y
SemimanifoldWitness)
(Embedding Affine s x y
q Affine s y x
_) (Shade x
x Metric' x
e) = y -> Metric' y -> Shade y
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade y
y ((Needle x +> Needle y) -> Metric' x -> Metric' y
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Variance v -> Variance w
transformVariance LinearMap s (Needle x) (Needle y)
Needle x +> Needle y
j Metric' x
e)
where y :: y
y = Affine s x y
q Affine s x y -> x -> y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x
(y
_,LinearMap s (Needle x) (Needle y)
j) = Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
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 x y
q x
x
projectShade :: Embedding (Affine s) x y -> Shade y -> Shade x
projectShade = (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade y -> Shade x
forall s x y.
(Semimanifold x, Object (Affine s) x, Object (Affine s) y,
SimpleSpace (Needle x), SemiInner (Needle y)) =>
(SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade y -> Shade x
ps' (SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness, SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness)
where ps' :: ∀ s x y . ( Semimanifold x
, Object (Affine s) x, Object (Affine s) y
, SimpleSpace (Needle x), SemiInner (Needle y) )
=> (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y
-> Shade y -> Shade x
ps' :: (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade y -> Shade x
ps' (SemimanifoldWitness x
SemimanifoldWitness, SemimanifoldWitness y
SemimanifoldWitness)
(Embedding Affine s x y
_ Affine s y x
q) (Shade y
x Metric' y
e) = x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
y ((Needle y +> Needle x) -> Metric' y -> Metric' x
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Variance v -> Variance w
transformVariance LinearMap s (Needle y) (Needle x)
Needle y +> Needle x
j Metric' y
e)
where y :: x
y = Affine s y x
q Affine s y x -> y -> x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ y
x
(x
_,LinearMap s (Needle y) (Needle x)
j) = Affine s y x -> y -> (x, LinearMap s (Needle y) (Needle x))
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 y x
q y
x
dualShade :: ∀ x . (PseudoAffine x, SimpleSpace (Needle x))
=> Shade x -> Shade' x
dualShade :: Shade x -> Shade' x
dualShade = case DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x) of
DualSpaceWitness (Needle x)
DualSpaceWitness -> \(Shade x
c Metric' x
e) -> x -> Norm (Needle x) -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
c (Norm (Needle x) -> Shade' x) -> Norm (Needle x) -> Shade' x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric' x -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric' x
e
dualShade' :: ∀ x . (PseudoAffine x, SimpleSpace (Needle x))
=> Shade' x -> Shade x
dualShade' :: Shade' x -> Shade x
dualShade' = case DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x) of
DualSpaceWitness (Needle x)
DualSpaceWitness -> \(Shade' x
c Metric x
e) -> x -> Norm (DualVector (Needle x)) -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
c (Norm (DualVector (Needle x)) -> Shade x)
-> Norm (DualVector (Needle x)) -> Shade x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Variance (DualVector (Needle x)) -> Norm (DualVector (Needle x))
forall v. SimpleSpace v => Variance v -> Norm v
dualNorm' Variance (DualVector (Needle x))
Metric x
e
instance ImpliesMetric Shade where
type MetricRequirement Shade x = (Manifold x, SimpleSpace (Needle x))
inferMetric' :: Shade x -> Metric' x
inferMetric' (Shade x
_ Metric' x
e) = Metric' x
e
inferMetric :: Shade x -> Metric x
inferMetric = DualNeedleWitness x -> Shade x -> Metric x
forall x.
(Manifold x, SimpleSpace (Needle x)) =>
DualNeedleWitness x -> Shade x -> Metric x
im DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where im :: (Manifold x, SimpleSpace (Needle x))
=> DualNeedleWitness x -> Shade x -> Metric x
im :: DualNeedleWitness x -> Shade x -> Metric x
im DualNeedleWitness x
DualSpaceWitness (Shade x
_ Metric' x
e) = Metric' x -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric' x
e
instance ImpliesMetric Shade' where
type MetricRequirement Shade' x = (Manifold x, SimpleSpace (Needle x))
inferMetric :: Shade' x -> Metric x
inferMetric (Shade' x
_ Metric x
e) = Metric x
e
inferMetric' :: Shade' x -> Metric' x
inferMetric' (Shade' x
_ Metric x
e) = Metric x -> Metric' x
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric x
e
shadeExpanse :: Lens' (Shade x) (Metric' x)
shadeExpanse :: (Metric' x -> f (Metric' x)) -> Shade x -> f (Shade x)
shadeExpanse Metric' x -> f (Metric' x)
f (Shade x
c Metric' x
e) = (Metric' x -> Shade x) -> f (Metric' x) -> f (Shade x)
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 (x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
c) (f (Metric' x) -> f (Shade x)) -> f (Metric' x) -> f (Shade x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric' x -> f (Metric' x)
f Metric' x
e
instance IsShade Shade' where
shadeCtr :: (x -> f x) -> Shade' x -> f (Shade' x)
shadeCtr x -> f x
f (Shade' x
c Metric x
e) = (x -> Shade' x) -> f x -> f (Shade' x)
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 (x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
`Shade'`Metric x
e) (f x -> f (Shade' x)) -> f x -> f (Shade' x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x -> f x
f x
c
occlusion :: Shade' x -> x -> s
occlusion = PseudoAffineWitness x -> Shade' x -> x -> s
forall x s.
(PseudoAffine x, SimpleSpace (Needle x), Scalar (Needle x) ~ s,
RealFloat' s) =>
PseudoAffineWitness x -> Shade' x -> x -> s
occ PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness
where occ :: ∀ x s . ( PseudoAffine x, SimpleSpace (Needle x)
, Scalar (Needle x) ~ s, RealFloat' s )
=> PseudoAffineWitness x -> Shade' x -> x -> s
occ :: PseudoAffineWitness x -> Shade' x -> x -> s
occ (PseudoAffineWitness (SemimanifoldWitness x
SemimanifoldWitness)) (Shade' x
p₀ Metric x
δinv) x
p
= case x
px -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
p₀ of
(Just Needle x
vd) | Scalar (Needle x)
mSq <- Metric x -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric x
δinv Needle x
vd
, s
Scalar (Needle x)
mSq s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
Scalar (Needle x)
mSq
-> s -> s
forall a. Floating a => a -> a
exp (s -> s
forall a. Num a => a -> a
negate s
Scalar (Needle x)
mSq)
Maybe (Needle x)
_ -> s
forall v. AdditiveGroup v => v
zeroV
factoriseShade :: Shade' (x, y) -> (Shade' x, Shade' y)
factoriseShade (Shade' (x
x₀,y
y₀) Metric (x, y)
δxy) = (x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
x₀ Metric x
δx, y -> Metric y -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' y
y₀ Metric y
δy)
where (Metric x
δx,Metric y
δy) = Norm (Needle x, Needle y) -> (Metric x, Metric y)
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
Norm (u, v) -> (Norm u, Norm v)
summandSpaceNorms Norm (Needle x, Needle y)
Metric (x, y)
δxy
orthoShades :: Shade' x -> Shade' y -> Shade' (x, y)
orthoShades (Shade' x
x Metric x
δx) (Shade' y
y Metric y
δy) = (x, y) -> Metric (x, y) -> Shade' (x, y)
forall x. x -> Metric x -> Shade' x
Shade' (x
x,y
y) (Norm (Needle x, Needle y) -> Shade' (x, y))
-> Norm (Needle x, Needle y) -> Shade' (x, y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric x -> Metric y -> Norm (Needle x, Needle y)
forall u v.
(LSpace u, LSpace v, Scalar u ~ Scalar v) =>
Norm u -> Norm v -> Norm (u, v)
sumSubspaceNorms Metric x
δx Metric y
δy
coerceShade :: Shade' x -> Shade' y
coerceShade = Shade' x -> Shade' y
forall x y. LocallyCoercible x y => Shade' x -> Shade' y
cS
where cS :: ∀ x y . (LocallyCoercible x y) => Shade' x -> Shade' y
cS :: Shade' x -> Shade' y
cS = \(Shade' x
x Metric x
δxym) -> y -> Metric y -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' (x -> y
forall x ξ. LocallyCoercible x ξ => x -> ξ
locallyTrivialDiffeomorphism x
x) (Metric x -> Metric y
tN Metric x
δxym)
where tN :: Metric x -> Metric y
tN = case CanonicalDiffeomorphism y x
forall x ξ. LocallyCoercible x ξ => CanonicalDiffeomorphism ξ x
oppositeLocalCoercion :: CanonicalDiffeomorphism y x of
CanonicalDiffeomorphism y x
CanonicalDiffeomorphism ->
LinearMap (Scalar (Needle y)) (Needle y) (Needle x)
-> Metric x -> Metric y
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm (LinearMap (Scalar (Needle y)) (Needle y) (Needle x)
-> Metric x -> Metric y)
-> (LinearFunction (Scalar (Needle y)) (Needle y) (Needle x)
-> LinearMap (Scalar (Needle y)) (Needle y) (Needle x))
-> LinearFunction (Scalar (Needle y)) (Needle y) (Needle x)
-> Metric x
-> Metric y
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearFunction (Scalar (Needle y)) (Needle y) (Needle x)
-> LinearMap (Scalar (Needle y)) (Needle y) (Needle x)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (LinearFunction (Scalar (Needle y)) (Needle y) (Needle x)
-> Metric x -> Metric y)
-> LinearFunction (Scalar (Needle y)) (Needle y) (Needle x)
-> Metric x
-> Metric y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [(y, x)] -> Needle y -+> Needle x
forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle x -+> Needle ξ
coerceNeedle ([]::[(y,x)])
linIsoTransformShade :: (x +> y) -> Shade' x -> Shade' y
linIsoTransformShade = LinearManifoldWitness x
-> LinearManifoldWitness y
-> DualSpaceWitness x
-> DualSpaceWitness y
-> (x +> y)
-> Shade' x
-> Shade' y
forall x y.
(SimpleSpace x, SimpleSpace y, Scalar x ~ Scalar y,
RealFloat' (Scalar x)) =>
LinearManifoldWitness x
-> LinearManifoldWitness y
-> DualSpaceWitness x
-> DualSpaceWitness y
-> (x +> y)
-> Shade' x
-> Shade' y
lits LinearManifoldWitness x
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness LinearManifoldWitness y
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness
DualSpaceWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness DualSpaceWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where lits :: ∀ x y . ( SimpleSpace x, SimpleSpace y
, Scalar x ~ Scalar y, RealFloat' (Scalar x) )
=> LinearManifoldWitness x -> LinearManifoldWitness y
-> DualSpaceWitness x -> DualSpaceWitness y
-> (x+>y) -> Shade' x -> Shade' y
lits :: LinearManifoldWitness x
-> LinearManifoldWitness y
-> DualSpaceWitness x
-> DualSpaceWitness y
-> (x +> y)
-> Shade' x
-> Shade' y
lits (LinearManifoldWitness x
LinearManifoldWitness)
(LinearManifoldWitness y
LinearManifoldWitness)
DualSpaceWitness x
DualSpaceWitness DualSpaceWitness y
DualSpaceWitness
x +> y
f (Shade' x
x Metric x
δx)
= y -> Metric y -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' (x +> y
LinearMap (Scalar y) x y
f LinearMap (Scalar y) x y -> x -> y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x) ((y +> x) -> Norm x -> Norm y
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm ((x +> y) -> y +> x
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v +> u
pseudoInverse x +> y
f) Norm x
Metric x
δx)
embedShade :: Embedding (Affine s) x y -> Shade' x -> Shade' y
embedShade = (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade' x -> Shade' y
forall s x y.
(Object (Affine s) x, Object (Affine s) y, SemiInner (Needle x),
SemiInner (Needle y)) =>
(SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade' x -> Shade' y
ps (SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness, SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness)
where ps :: ∀ s x y . ( Object (Affine s) x, Object (Affine s) y
, SemiInner (Needle x), SemiInner (Needle y) )
=> (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y
-> Shade' x -> Shade' y
ps :: (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade' x -> Shade' y
ps (SemimanifoldWitness x
SemimanifoldWitness, SemimanifoldWitness y
SemimanifoldWitness)
(Embedding Affine s x y
q Affine s y x
p) (Shade' x
x Metric x
e) = y -> Metric y -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' y
y ((Needle y +> Needle x) -> Metric x -> Metric y
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s (Needle y) (Needle x)
Needle y +> Needle x
j Metric x
e)
where y :: y
y = Affine s x y
q Affine s x y -> x -> y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x
(x
_,LinearMap s (Needle y) (Needle x)
j) = Affine s y x -> y -> (x, LinearMap s (Needle y) (Needle x))
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 y x
p y
y
projectShade :: Embedding (Affine s) x y -> Shade' y -> Shade' x
projectShade = (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade' y -> Shade' x
forall s x y.
(Object (Affine s) x, Object (Affine s) y, SemiInner (Needle x),
SemiInner (Needle y)) =>
(SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade' y -> Shade' x
ps (SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness, SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness)
where ps :: ∀ s x y . ( Object (Affine s) x, Object (Affine s) y
, SemiInner (Needle x), SemiInner (Needle y) )
=> (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y
-> Shade' y -> Shade' x
ps :: (SemimanifoldWitness x, SemimanifoldWitness y)
-> Embedding (Affine s) x y -> Shade' y -> Shade' x
ps (SemimanifoldWitness x
SemimanifoldWitness, SemimanifoldWitness y
SemimanifoldWitness)
(Embedding Affine s x y
p Affine s y x
q) (Shade' y
x Metric y
e) = x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
y ((Needle x +> Needle y) -> Metric y -> Metric x
forall v w.
(LSpace v, LSpace w, Scalar v ~ Scalar w) =>
(v +> w) -> Norm w -> Norm v
transformNorm LinearMap s (Needle x) (Needle y)
Needle x +> Needle y
j Metric y
e)
where y :: x
y = Affine s y x
q Affine s y x -> y -> x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ y
x
(y
_,LinearMap s (Needle x) (Needle y)
j) = Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
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 x y
p x
y
shadeNarrowness :: Lens' (Shade' x) (Metric x)
shadeNarrowness :: (Metric x -> f (Metric x)) -> Shade' x -> f (Shade' x)
shadeNarrowness Metric x -> f (Metric x)
f (Shade' x
c Metric x
e) = (Metric x -> Shade' x) -> f (Metric x) -> f (Shade' x)
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 (x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
c) (f (Metric x) -> f (Shade' x)) -> f (Metric x) -> f (Shade' x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric x -> f (Metric x)
f Metric x
e
newtype ShadeNeedle x = ShadeNeedle { ShadeNeedle x -> Needle x
shadeCtrDiff :: Needle x
}
deriving instance (AdditiveGroup (Needle x)) => AdditiveGroup (ShadeNeedle x)
deriving instance (VectorSpace (Needle x)) => VectorSpace (ShadeNeedle x)
instance (VectorSpace (Needle x)) => Semimanifold (ShadeNeedle x) where
type Needle (ShadeNeedle x) = ShadeNeedle x
.+~^ :: ShadeNeedle x -> Needle (ShadeNeedle x) -> ShadeNeedle x
(.+~^) = ShadeNeedle x -> Needle (ShadeNeedle x) -> ShadeNeedle x
forall v. AdditiveGroup v => v -> v -> v
(^+^)
instance ∀ x . (PseudoAffine x, VectorSpace (Needle x)) => Semimanifold (Shade x) where
type Needle (Shade x) = ShadeNeedle x
.+~^ :: Shade x -> Needle (Shade x) -> Shade x
(.+~^) = case SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness x of
SemimanifoldWitness x
SemimanifoldWitness
-> \(Shade x
c Metric' x
e) (ShadeNeedle v) -> x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (x
cx -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle x
v) Metric' x
e
.-~^ :: Shade x -> Needle (Shade x) -> Shade x
(.-~^) = case SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness x of
SemimanifoldWitness x
SemimanifoldWitness
-> \(Shade x
c Metric' x
e) (ShadeNeedle v) -> x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (x
cx -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.-~^Needle x
v) Metric' x
e
semimanifoldWitness :: SemimanifoldWitness (Shade x)
semimanifoldWitness = case SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness x of
(SemimanifoldWitness x
SemimanifoldWitness)
-> SemimanifoldWitness (Shade x)
forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness
data ShadeHalfNeedle x = ShadeHalfNeedle
instance AdditiveMonoid (ShadeHalfNeedle x) where
zeroHV :: ShadeHalfNeedle x
zeroHV = ShadeHalfNeedle x
forall a. HasCallStack => a
undefined
addHVs :: ShadeHalfNeedle x -> ShadeHalfNeedle x -> ShadeHalfNeedle x
addHVs = ShadeHalfNeedle x -> ShadeHalfNeedle x -> ShadeHalfNeedle x
forall a. HasCallStack => a
undefined
instance ( VectorSpace (Needle x)
) => HalfSpace (ShadeHalfNeedle x) where
type FullSubspace (ShadeHalfNeedle x) = Needle x
type Ray (ShadeHalfNeedle x) = Ray x
type MirrorJoin (ShadeHalfNeedle x) = Needle x
scaleNonNeg :: Ray (ShadeHalfNeedle x) -> ShadeHalfNeedle x -> ShadeHalfNeedle x
scaleNonNeg = Ray (ShadeHalfNeedle x) -> ShadeHalfNeedle x -> ShadeHalfNeedle x
forall a. HasCallStack => a
undefined
fromFullSubspace :: FullSubspace (ShadeHalfNeedle x) -> ShadeHalfNeedle x
fromFullSubspace = FullSubspace (ShadeHalfNeedle x) -> ShadeHalfNeedle x
forall a. HasCallStack => a
undefined
projectToFullSubspace :: ShadeHalfNeedle x -> FullSubspace (ShadeHalfNeedle x)
projectToFullSubspace = ShadeHalfNeedle x -> FullSubspace (ShadeHalfNeedle x)
forall a. HasCallStack => a
undefined
fullSubspaceIsVectorSpace :: ((VectorSpace (FullSubspace (ShadeHalfNeedle x)),
ScalarSpace (Scalar (FullSubspace (ShadeHalfNeedle x))),
Scalar (FullSubspace (ShadeHalfNeedle x))
~ MirrorJoin (Ray (ShadeHalfNeedle x))) =>
r)
-> r
fullSubspaceIsVectorSpace (VectorSpace (FullSubspace (ShadeHalfNeedle x)),
ScalarSpace (Scalar (FullSubspace (ShadeHalfNeedle x))),
Scalar (FullSubspace (ShadeHalfNeedle x))
~ MirrorJoin (Ray (ShadeHalfNeedle x))) =>
r
_ = r
forall a. HasCallStack => a
undefined
rayIsHalfSpace :: (HalfSpace (Ray (ShadeHalfNeedle x)) => r) -> r
rayIsHalfSpace HalfSpace (Ray (ShadeHalfNeedle x)) => r
_ = r
forall a. HasCallStack => a
undefined
mirrorJoinIsVectorSpace :: ((VectorSpace (MirrorJoin (ShadeHalfNeedle x)),
Scalar (MirrorJoin (ShadeHalfNeedle x))
~ MirrorJoin (Ray (ShadeHalfNeedle x))) =>
r)
-> r
mirrorJoinIsVectorSpace (VectorSpace (MirrorJoin (ShadeHalfNeedle x)),
Scalar (MirrorJoin (ShadeHalfNeedle x))
~ MirrorJoin (Ray (ShadeHalfNeedle x))) =>
r
_ = r
forall a. HasCallStack => a
undefined
fromPositiveHalf :: ShadeHalfNeedle x -> MirrorJoin (ShadeHalfNeedle x)
fromPositiveHalf = ShadeHalfNeedle x -> MirrorJoin (ShadeHalfNeedle x)
forall a. HasCallStack => a
undefined
fromNegativeHalf :: ShadeHalfNeedle x -> MirrorJoin (ShadeHalfNeedle x)
fromNegativeHalf = ShadeHalfNeedle x -> MirrorJoin (ShadeHalfNeedle x)
forall a. HasCallStack => a
undefined
instance ( AffineSpace x, Manifold x, Diff x ~ Needle x
, Atlas x, HasTrie (ChartIndex x)
, LinearSpace (Needle x), LinearSpace (Needle' x)
, Num' (Scalar (Needle x))
) => SemimanifoldWithBoundary (Shade x) where
type Interior (Shade x) = Shade' x
type Boundary (Shade x) = x
type HalfNeedle (Shade x) = ShadeHalfNeedle x
extendToBoundary :: Interior (Shade x)
-> Needle (Interior (Shade x)) -> Maybe (Boundary (Shade x))
extendToBoundary = Interior (Shade x)
-> Needle (Interior (Shade x)) -> Maybe (Boundary (Shade x))
forall a. HasCallStack => a
undefined
smfdWBoundWitness :: SmfdWBoundWitness (Shade x)
smfdWBoundWitness = SmfdWBoundWitness (Shade x)
forall a. HasCallStack => a
undefined
needleIsOpenMfd :: (OpenManifold (Needle (Interior (Shade x))) => r) -> r
needleIsOpenMfd OpenManifold (Needle (Interior (Shade x))) => r
_ = r
forall a. HasCallStack => a
undefined
scalarIsOpenMfd :: (OpenManifold (Scalar (Needle (Interior (Shade x)))) => r) -> r
scalarIsOpenMfd OpenManifold (Scalar (Needle (Interior (Shade x)))) => r
_ = r
forall a. HasCallStack => a
undefined
instance ( AffineSpace x, Manifold x, Diff x ~ Needle x
, Atlas x, HasTrie (ChartIndex x)
, Geodesic x
, LinearSpace (Needle x), LinearSpace (Needle' x)
, Scalar (Needle x) ~ ℝ
) => Geodesic (Shade x) where
geodesicBetween :: Shade x -> Shade x -> Maybe (D¹ -> Shade x)
geodesicBetween = DualNeedleWitness x -> Shade x -> Shade x -> Maybe (D¹ -> Shade x)
gb DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where gb :: DualNeedleWitness x -> Shade x -> Shade x -> Maybe (D¹ -> Shade x)
gb :: DualNeedleWitness x -> Shade x -> Shade x -> Maybe (D¹ -> Shade x)
gb DualNeedleWitness x
DualSpaceWitness (Shade x
c (Norm Needle' x -+> DualVector (Needle' x)
e)) (Shade x
ζ (Norm Needle' x -+> DualVector (Needle' x)
η)) = (D¹ -> Shade x) -> Maybe (D¹ -> Shade x)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure D¹ -> Shade x
interp
where interp :: D¹ -> Shade x
interp t :: D¹
t@(D¹ ℝ
q) = x -> Norm (Needle' x) -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (D¹ -> x
pinterp D¹
t)
(LinearFunction
(Scalar (Needle x)) (Needle' x) (DualVector (Needle' x))
-> Norm (Needle' x)
forall v. (v -+> DualVector v) -> Norm v
Norm (LinearFunction
(Scalar (Needle x)) (Needle' x) (DualVector (Needle' x))
-> Norm (Needle' x))
-> (ℝ
-> LinearFunction
(Scalar (Needle x)) (Needle' x) (DualVector (Needle' x)))
-> ℝ
-> Norm (Needle' x)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearMap ℝ (Needle' x) (Needle x)
-> LinearFunction
(Scalar (Needle x)) (Needle' x) (DualVector (Needle' x))
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 (LinearMap ℝ (Needle' x) (Needle x)
-> LinearFunction
(Scalar (Needle x)) (Needle' x) (DualVector (Needle' x)))
-> (ℝ -> LinearMap ℝ (Needle' x) (Needle x))
-> ℝ
-> LinearFunction
(Scalar (Needle x)) (Needle' x) (DualVector (Needle' x))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearMap ℝ (Needle' x) (Needle x)
-> LinearMap ℝ (Needle' x) (Needle x)
-> Scalar (LinearMap ℝ (Needle' x) (Needle x))
-> LinearMap ℝ (Needle' x) (Needle x)
forall v. VectorSpace v => v -> v -> Scalar v -> v
lerp LinearMap ℝ (Needle' x) (Needle x)
ed LinearMap ℝ (Needle' x) (Needle x)
ηd (ℝ -> Norm (Needle' x)) -> ℝ -> Norm (Needle' x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ
qℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
1)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2)
ed :: LinearMap ℝ (Needle' x) (Needle x)
ed@(LinearMap TensorProduct (DualVector (Needle' x)) (Needle x)
_) = LinearFunction ℝ (Needle' x) (Needle x)
-> LinearMap ℝ (Needle' x) (Needle x)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr LinearFunction ℝ (Needle' x) (Needle x)
Needle' x -+> DualVector (Needle' x)
e
ηd :: LinearMap ℝ (Needle' x) (Needle x)
ηd@(LinearMap TensorProduct (DualVector (Needle' x)) (Needle x)
_) = LinearFunction ℝ (Needle' x) (Needle x)
-> LinearMap ℝ (Needle' x) (Needle x)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr LinearFunction ℝ (Needle' x) (Needle x)
Needle' x -+> DualVector (Needle' x)
η
Just D¹ -> x
pinterp = x -> x -> Maybe (D¹ -> x)
forall x. Geodesic x => x -> x -> Maybe (D¹ -> x)
geodesicBetween x
c x
ζ
newtype Shade'Needle x = Shade'Needle { Shade'Needle x -> Needle x
shade'CtrDiff :: Needle x
}
deriving instance (AdditiveGroup (Needle x)) => AdditiveGroup (Shade'Needle x)
deriving instance (VectorSpace (Needle x)) => VectorSpace (Shade'Needle x)
instance (VectorSpace (Needle x)) => Semimanifold (Shade'Needle x) where
type Needle (Shade'Needle x) = Shade'Needle x
.+~^ :: Shade'Needle x -> Needle (Shade'Needle x) -> Shade'Needle x
(.+~^) = Shade'Needle x -> Needle (Shade'Needle x) -> Shade'Needle x
forall v. AdditiveGroup v => v -> v -> v
(^+^)
instance (AffineManifold x) => Semimanifold (Shade' x) where
type Needle (Shade' x) = Shade'Needle x
Shade' x
c Metric x
e .+~^ :: Shade' x -> Needle (Shade' x) -> Shade' x
.+~^ Shade'Needle v = x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' (x
cx -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle x
v) Metric x
e
Shade' x
c Metric x
e .-~^ :: Shade' x -> Needle (Shade' x) -> Shade' x
.-~^ Shade'Needle v = x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' (x
cx -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.-~^Needle x
v) Metric x
e
semimanifoldWitness :: SemimanifoldWitness (Shade' x)
semimanifoldWitness = case SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness x of
SemimanifoldWitness x
SemimanifoldWitness -> SemimanifoldWitness (Shade' x)
forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness
data Shade'HalfNeedle x = Shade'HalfNeedle
instance AdditiveMonoid (Shade'HalfNeedle x) where
zeroHV :: Shade'HalfNeedle x
zeroHV = Shade'HalfNeedle x
forall a. HasCallStack => a
undefined
addHVs :: Shade'HalfNeedle x -> Shade'HalfNeedle x -> Shade'HalfNeedle x
addHVs = Shade'HalfNeedle x -> Shade'HalfNeedle x -> Shade'HalfNeedle x
forall a. HasCallStack => a
undefined
instance ( VectorSpace (Needle x)
) => HalfSpace (Shade'HalfNeedle x) where
type FullSubspace (Shade'HalfNeedle x) = Needle x
type Ray (Shade'HalfNeedle x) = Ray x
type MirrorJoin (Shade'HalfNeedle x) = Needle x
scaleNonNeg :: Ray (Shade'HalfNeedle x)
-> Shade'HalfNeedle x -> Shade'HalfNeedle x
scaleNonNeg = Ray (Shade'HalfNeedle x)
-> Shade'HalfNeedle x -> Shade'HalfNeedle x
forall a. HasCallStack => a
undefined
fromFullSubspace :: FullSubspace (Shade'HalfNeedle x) -> Shade'HalfNeedle x
fromFullSubspace = FullSubspace (Shade'HalfNeedle x) -> Shade'HalfNeedle x
forall a. HasCallStack => a
undefined
projectToFullSubspace :: Shade'HalfNeedle x -> FullSubspace (Shade'HalfNeedle x)
projectToFullSubspace = Shade'HalfNeedle x -> FullSubspace (Shade'HalfNeedle x)
forall a. HasCallStack => a
undefined
fullSubspaceIsVectorSpace :: ((VectorSpace (FullSubspace (Shade'HalfNeedle x)),
ScalarSpace (Scalar (FullSubspace (Shade'HalfNeedle x))),
Scalar (FullSubspace (Shade'HalfNeedle x))
~ MirrorJoin (Ray (Shade'HalfNeedle x))) =>
r)
-> r
fullSubspaceIsVectorSpace (VectorSpace (FullSubspace (Shade'HalfNeedle x)),
ScalarSpace (Scalar (FullSubspace (Shade'HalfNeedle x))),
Scalar (FullSubspace (Shade'HalfNeedle x))
~ MirrorJoin (Ray (Shade'HalfNeedle x))) =>
r
_ = r
forall a. HasCallStack => a
undefined
rayIsHalfSpace :: (HalfSpace (Ray (Shade'HalfNeedle x)) => r) -> r
rayIsHalfSpace HalfSpace (Ray (Shade'HalfNeedle x)) => r
_ = r
forall a. HasCallStack => a
undefined
mirrorJoinIsVectorSpace :: ((VectorSpace (MirrorJoin (Shade'HalfNeedle x)),
Scalar (MirrorJoin (Shade'HalfNeedle x))
~ MirrorJoin (Ray (Shade'HalfNeedle x))) =>
r)
-> r
mirrorJoinIsVectorSpace (VectorSpace (MirrorJoin (Shade'HalfNeedle x)),
Scalar (MirrorJoin (Shade'HalfNeedle x))
~ MirrorJoin (Ray (Shade'HalfNeedle x))) =>
r
_ = r
forall a. HasCallStack => a
undefined
fromPositiveHalf :: Shade'HalfNeedle x -> MirrorJoin (Shade'HalfNeedle x)
fromPositiveHalf = Shade'HalfNeedle x -> MirrorJoin (Shade'HalfNeedle x)
forall a. HasCallStack => a
undefined
fromNegativeHalf :: Shade'HalfNeedle x -> MirrorJoin (Shade'HalfNeedle x)
fromNegativeHalf = Shade'HalfNeedle x -> MirrorJoin (Shade'HalfNeedle x)
forall a. HasCallStack => a
undefined
instance ( AffineSpace x, Manifold x, Diff x ~ Needle x
, Atlas' x
, LinearSpace (Needle x), LinearSpace (Needle' x)
) => SemimanifoldWithBoundary (Shade' x) where
type Interior (Shade' x) = Shade x
type Boundary (Shade' x) = x
type HalfNeedle (Shade' x) = Shade'HalfNeedle x
extendToBoundary :: Interior (Shade' x)
-> Needle (Interior (Shade' x)) -> Maybe (Boundary (Shade' x))
extendToBoundary = Interior (Shade' x)
-> Needle (Interior (Shade' x)) -> Maybe (Boundary (Shade' x))
forall a. HasCallStack => a
undefined
smfdWBoundWitness :: SmfdWBoundWitness (Shade' x)
smfdWBoundWitness = SmfdWBoundWitness (Shade' x)
forall a. HasCallStack => a
undefined
needleIsOpenMfd :: (OpenManifold (Needle (Interior (Shade' x))) => r) -> r
needleIsOpenMfd OpenManifold (Needle (Interior (Shade' x))) => r
_ = r
forall a. HasCallStack => a
undefined
scalarIsOpenMfd :: (OpenManifold (Scalar (Needle (Interior (Shade' x)))) => r) -> r
scalarIsOpenMfd OpenManifold (Scalar (Needle (Interior (Shade' x)))) => r
_ = r
forall a. HasCallStack => a
undefined
instance ∀ x . (WithField ℝ AffineManifold x, Geodesic x, SimpleSpace (Needle x))
=> Geodesic (Shade' x) where
geodesicBetween :: Shade' x -> Shade' x -> Maybe (D¹ -> Shade' x)
geodesicBetween (Shade' x
c Metric x
e) (Shade' x
ζ Metric x
η) = (D¹ -> Shade' x) -> Maybe (D¹ -> Shade' x)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure D¹ -> Shade' x
interp
where sharedSpan :: [(DualVector (Diff x), Scalar (Diff x))]
sharedSpan = Norm (Diff x)
-> Norm (Diff x) -> [(DualVector (Diff x), Scalar (Diff x))]
forall v.
SimpleSpace v =>
Norm v -> Norm v -> [(DualVector v, Scalar v)]
sharedNormSpanningSystem Norm (Diff x)
Metric x
e Norm (Diff x)
Metric x
η
interp :: D¹ -> Shade' x
interp D¹
t = x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' (D¹ -> x
pinterp D¹
t)
([DualVector (Diff x)] -> Norm (Diff x)
forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [ DualVector (Needle x)
v DualVector (Needle x) -> ℝ -> DualVector (Needle x)
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (ℝ -> ℝ -> D¹ -> ℝ
forall x.
(AffineSpace x, VectorSpace (Diff x), Scalar (Diff x) ~ ℝ) =>
x -> x -> D¹ -> x
alerpB ℝ
1 (ℝ -> ℝ
forall a. Fractional a => a -> a
recip ℝ
qη) D¹
t)
| (DualVector (Needle x)
v,ℝ
qη) <- [(DualVector (Diff x), Scalar (Diff x))]
[(DualVector (Needle x), ℝ)]
sharedSpan ])
Just D¹ -> x
pinterp = x -> x -> Maybe (D¹ -> x)
forall x. Geodesic x => x -> x -> Maybe (D¹ -> x)
geodesicBetween x
c x
ζ
fullShade :: (Semimanifold x, SimpleSpace (Needle x))
=> x -> Metric' x -> Shade x
fullShade :: x -> Metric' x -> Shade x
fullShade x
ctr Metric' x
expa = x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
ctr Metric' x
expa
fullShade' :: WithField ℝ SimpleSpace x => x -> Metric x -> Shade' x
fullShade' :: x -> Metric x -> Shade' x
fullShade' x
ctr Metric x
expa = x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
ctr Metric x
expa
infixl 6 :±, |±|
#if GLASGOW_HASKELL < 800
pattern (:±) :: ()
#else
pattern (:±) :: (Semimanifold x, SimpleSpace (Needle x))
#endif
=> (Semimanifold x, SimpleSpace (Needle x))
=> x -> [Needle x] -> Shade x
pattern x $b:± :: x -> [Needle x] -> Shade x
$m:± :: forall r x.
Shade x
-> ((Semimanifold x, SimpleSpace (Needle x)) =>
x -> [Needle x] -> r)
-> (Void# -> r)
-> r
:± shs <- (Shade x (varianceSpanningSystem -> shs))
where x
x :± [Needle x]
shs = x -> Norm (DualVector (Needle x)) -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
fullShade x
x (Norm (DualVector (Needle x)) -> Shade x)
-> Norm (DualVector (Needle x)) -> Shade x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Needle x] -> Norm (DualVector (Needle x))
forall v. LSpace v => [v] -> Variance v
spanVariance [Needle x]
shs
(|±|) :: ∀ x . WithField ℝ EuclidSpace x => x -> [Needle x] -> Shade' x
x
x|±| :: x -> [Needle x] -> Shade' x
|±|[Needle x]
shs = x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
x (Norm (Diff x) -> Shade' x) -> Norm (Diff x) -> Shade' x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [DualVector (Diff x)] -> Norm (Diff x)
forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [Diff x
vDiff x -> ℝ -> Diff x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/(Diff x
vDiff x -> Diff x -> Scalar (Diff x)
forall v. InnerSpace v => v -> v -> Scalar v
<.>Diff x
v) | Diff x
v<-[Diff x]
[Needle x]
shs]
pointsShades :: (WithField ℝ PseudoAffine x, SimpleSpace (Needle x))
=> [x] -> [Shade x]
pointsShades :: [x] -> [Shade x]
pointsShades = (([(x, ())], Shade x) -> Shade x)
-> [([(x, ())], Shade x)] -> [Shade x]
forall a b. (a -> b) -> [a] -> [b]
map ([(x, ())], Shade x) -> Shade x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd ([([(x, ())], Shade x)] -> [Shade x])
-> ([x] -> [([(x, ())], Shade x)]) -> [x] -> [Shade x]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Metric' x -> [(x, ())] -> [([(x, ())], Shade x)]
forall x y.
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x)) =>
Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
pointsShades' Metric' x
forall a. Monoid a => a
mempty ([(x, ())] -> [([(x, ())], Shade x)])
-> ([x] -> [(x, ())]) -> [x] -> [([(x, ())], Shade x)]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (x -> (x, ())) -> [x] -> [(x, ())]
forall a b. (a -> b) -> [a] -> [b]
map ((,()))
coverAllAround :: ∀ x s . ( Fractional' s, WithField s PseudoAffine x
, SimpleSpace (Needle x) )
=> x -> [Needle x] -> Shade x
coverAllAround :: x -> [Needle x] -> Shade x
coverAllAround x
x₀ [Needle x]
offs = x -> Norm (DualVector (Needle x)) -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
x₀
(Norm (DualVector (Needle x)) -> Shade x)
-> Norm (DualVector (Needle x)) -> Shade x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DualNeedleWitness x
-> [Needle x]
-> Norm (DualVector (Needle x))
-> Norm (DualVector (Needle x))
guaranteeIn DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness [Needle x]
offs
(Scalar (DualVector (Needle x))
-> Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x))
forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm (s
1s -> s -> s
forall a. Fractional a => a -> a -> a
/Int -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Needle x] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Needle x]
offs)) (Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x)))
-> Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Needle x] -> Norm (DualVector (Needle x))
forall v. LSpace v => [v] -> Variance v
spanVariance [Needle x]
offs)
where guaranteeIn :: DualNeedleWitness x -> [Needle x] -> Metric' x -> Metric' x
guaranteeIn :: DualNeedleWitness x
-> [Needle x]
-> Norm (DualVector (Needle x))
-> Norm (DualVector (Needle x))
guaranteeIn w :: DualNeedleWitness x
w@DualNeedleWitness x
DualSpaceWitness [Needle x]
offs Norm (DualVector (Needle x))
ex
= case [Needle x]
offs [Needle x]
-> (Needle x -> [(Needle x, Norm (DualVector (Needle x)))])
-> [(Needle x, Norm (DualVector (Needle x)))]
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Function f, Monad m f, Object f a, Object f b, Object f (m a),
Object f (m b), Object f (m (m b))) =>
m a -> f a (m b) -> m b
>>= \Needle x
v -> Bool -> [()]
forall (m :: * -> *) (k :: * -> * -> *).
(MonadPlus m k, Arrow k (->), Function k, UnitObject k ~ (),
Object k Bool) =>
k Bool (m ())
guard ((Variance (DualVector (Needle x))
Norm (Needle x)
ex'Norm (Needle x) -> Needle x -> Scalar (Needle x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|Needle x
v) s -> s -> Bool
forall a. Ord a => a -> a -> Bool
> s
1) [()]
-> [(Needle x, Norm (DualVector (Needle x)))]
-> [(Needle x, Norm (DualVector (Needle x)))]
forall (k :: * -> * -> *) (m :: * -> *) b a.
(WellPointed k, Monad m k, ObjectPair k b (UnitObject k),
ObjectPair k (m b) (UnitObject k),
ObjectPair k (UnitObject k) (m b), ObjectPair k b a,
ObjectPair k a b, Object k (m (a, b)), ObjectPair k (m a) (m b),
ObjectPoint k (m a)) =>
m a -> k (m b) (m b)
>> [(Needle x
v, [Needle x] -> Norm (DualVector (Needle x))
forall v. LSpace v => [v] -> Variance v
spanVariance [Needle x
v])] of
[] -> Norm (DualVector (Needle x))
ex
[(Needle x, Norm (DualVector (Needle x)))]
outs -> DualNeedleWitness x
-> [Needle x]
-> Norm (DualVector (Needle x))
-> Norm (DualVector (Needle x))
guaranteeIn DualNeedleWitness x
w ((Needle x, Norm (DualVector (Needle x))) -> Needle x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst((Needle x, Norm (DualVector (Needle x))) -> Needle x)
-> [(Needle x, Norm (DualVector (Needle x)))] -> [Needle x]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Needle x, Norm (DualVector (Needle x)))]
outs)
( Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x))
forall v. LSpace v => Norm v -> Norm v
densifyNorm (Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x)))
-> Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
Norm (DualVector (Needle x))
ex Norm (DualVector (Needle x))
-> Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x))
forall a. Semigroup a => a -> a -> a
<> Scalar (DualVector (Needle x))
-> Norm (DualVector (Needle x)) -> Norm (DualVector (Needle x))
forall v. LSpace v => Scalar v -> Norm v -> Norm v
scaleNorm
(s -> s
forall a. Floating a => a -> a
sqrt (s -> s) -> (Int -> s) -> Int -> s
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
. s -> s
forall a. Fractional a => a -> a
recip (s -> s) -> (Int -> s) -> Int -> s
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
. Int -> s
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Int -> s) -> Int -> s
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* [(Needle x, Norm (DualVector (Needle x)))] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Needle x, Norm (DualVector (Needle x)))]
outs)
([Norm (DualVector (Needle x))] -> Norm (DualVector (Needle x))
forall a. Monoid a => [a] -> a
mconcat ([Norm (DualVector (Needle x))] -> Norm (DualVector (Needle x)))
-> [Norm (DualVector (Needle x))] -> Norm (DualVector (Needle x))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Needle x, Norm (DualVector (Needle x)))
-> Norm (DualVector (Needle x))
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((Needle x, Norm (DualVector (Needle x)))
-> Norm (DualVector (Needle x)))
-> [(Needle x, Norm (DualVector (Needle x)))]
-> [Norm (DualVector (Needle x))]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(Needle x, Norm (DualVector (Needle x)))]
outs)
)
where ex' :: Variance (DualVector (Needle x))
ex' = Norm (DualVector (Needle x)) -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Norm (DualVector (Needle x))
ex
pointsCovers :: ∀ x . (WithField ℝ PseudoAffine x, SimpleSpace (Needle x))
=> [x] -> [Shade x]
pointsCovers :: [x] -> [Shade x]
pointsCovers = case PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness x of
(PseudoAffineWitness (SemimanifoldWitness x
SemimanifoldWitness)) ->
\[x]
ps -> (([(x, ())], Shade x) -> Shade x)
-> [([(x, ())], Shade x)] -> [Shade x]
forall a b. (a -> b) -> [a] -> [b]
map (\([(x, ())]
ps', Shade x
x₀ Metric' x
_)
-> x -> [Needle x] -> Shade x
forall x s.
(Fractional' s, WithField s PseudoAffine x,
SimpleSpace (Needle x)) =>
x -> [Needle x] -> Shade x
coverAllAround x
x₀ [Needle x
v | (x
p,())<-[(x, ())]
ps'
, let Just Needle x
v
= x
px -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
x₀])
(Metric' x -> [(x, ())] -> [([(x, ())], Shade x)]
forall x y.
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x)) =>
Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
pointsShades' Metric' x
forall a. Monoid a => a
mempty ((,())(x -> (x, ())) -> [x] -> [(x, ())]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[x]
ps)
:: [([(x,())], Shade x)])
pointsShade's :: ∀ x . (WithField ℝ PseudoAffine x, SimpleSpace (Needle x))
=> [x] -> [Shade' x]
pointsShade's :: [x] -> [Shade' x]
pointsShade's = case DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x of
DualSpaceWitness (Needle x)
DualSpaceWitness -> (Shade x -> Shade' x) -> [Shade x] -> [Shade' x]
forall a b. (a -> b) -> [a] -> [b]
map (\(Shade x
c Metric' x
e :: Shade x) -> x -> Norm (Needle x) -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
c (Norm (Needle x) -> Shade' x) -> Norm (Needle x) -> Shade' x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric' x -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric' x
e) ([Shade x] -> [Shade' x])
-> ([x] -> [Shade x]) -> [x] -> [Shade' x]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [x] -> [Shade x]
forall x.
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x)) =>
[x] -> [Shade x]
pointsShades
pointsCover's :: ∀ x . (WithField ℝ PseudoAffine x, SimpleSpace (Needle x))
=> [x] -> [Shade' x]
pointsCover's :: [x] -> [Shade' x]
pointsCover's = case DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x of
DualSpaceWitness (Needle x)
DualSpaceWitness -> (Shade x -> Shade' x) -> [Shade x] -> [Shade' x]
forall a b. (a -> b) -> [a] -> [b]
map (\(Shade x
c Metric' x
e :: Shade x) -> x -> Norm (Needle x) -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
c (Norm (Needle x) -> Shade' x) -> Norm (Needle x) -> Shade' x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric' x -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric' x
e) ([Shade x] -> [Shade' x])
-> ([x] -> [Shade x]) -> [x] -> [Shade' x]
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [x] -> [Shade x]
forall x.
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x)) =>
[x] -> [Shade x]
pointsCovers
pseudoECM :: ∀ x y p . (WithField ℝ PseudoAffine x, SimpleSpace (Needle x), Hask.Functor p)
=> p x -> NonEmpty (x,y) -> (x, ([(x,y)],[(x,y)]))
pseudoECM :: p x -> NonEmpty (x, y) -> (x, ([(x, y)], [(x, y)]))
pseudoECM = case SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness x of
SemimanifoldWitness x
SemimanifoldWitness ->
\p x
_ ((x
p₀,y
y₀) NE.:| [(x, y)]
psr) -> ((x, ([(x, y)], [(x, y)]))
-> (ℝ, (x, y)) -> (x, ([(x, y)], [(x, y)])))
-> (x, ([(x, y)], [(x, y)]))
-> [(ℝ, (x, y))]
-> (x, ([(x, y)], [(x, y)]))
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ( \(x
acc, ([(x, y)]
rb,[(x, y)]
nr)) (ℝ
i,(x
p,y
y))
-> case (x
px -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
acc, x
acc) of
(Just Needle x
δ, x
acci)
-> (x
acci x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
δNeedle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
i, ((x
p,y
y)(x, y) -> [(x, y)] -> [(x, y)]
forall a. a -> [a] -> [a]
:[(x, y)]
rb, [(x, y)]
nr))
(Maybe (Needle x), x)
_ -> (x
acc, ([(x, y)]
rb, (x
p,y
y)(x, y) -> [(x, y)] -> [(x, y)]
forall a. a -> [a] -> [a]
:[(x, y)]
nr)) )
(x
p₀, ([(x, y)], [(x, y)])
forall a. Monoid a => a
mempty)
( [ℝ] -> [(x, y)] -> [(ℝ, (x, y))]
forall a b. [a] -> [b] -> [(a, b)]
zip [ℝ
1..] ([(x, y)] -> [(ℝ, (x, y))]) -> [(x, y)] -> [(ℝ, (x, y))]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (x
p₀,y
y₀)(x, y) -> [(x, y)] -> [(x, y)]
forall a. a -> [a] -> [a]
:[(x, y)]
psr )
pointsShades' :: ∀ x y . (WithField ℝ PseudoAffine x, SimpleSpace (Needle x))
=> Metric' x -> [(x,y)] -> [([(x,y)], Shade x)]
pointsShades' :: Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
pointsShades' Metric' x
_ [] = []
pointsShades' Metric' x
minExt [(x, y)]
ps = case (Maybe (Metric' x)
expa, x
ctr) of
(Just Metric' x
e, x
c)
-> ([(x, y)]
ps, x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
fullShade x
c Metric' x
e) ([(x, y)], Shade x)
-> [([(x, y)], Shade x)] -> [([(x, y)], Shade x)]
forall a. a -> [a] -> [a]
: Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
forall x y.
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x)) =>
Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
pointsShades' Metric' x
minExt [(x, y)]
unreachable
(Maybe (Metric' x), x)
_ -> Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
forall x y.
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x)) =>
Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
pointsShades' Metric' x
minExt [(x, y)]
inc'd
[([(x, y)], Shade x)]
-> [([(x, y)], Shade x)] -> [([(x, y)], Shade x)]
forall a. [a] -> [a] -> [a]
++ Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
forall x y.
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x)) =>
Metric' x -> [(x, y)] -> [([(x, y)], Shade x)]
pointsShades' Metric' x
minExt [(x, y)]
unreachable
where (x
ctr,([(x, y)]
inc'd,[(x, y)]
unreachable)) = [x] -> NonEmpty (x, y) -> (x, ([(x, y)], [(x, y)]))
forall x y (p :: * -> *).
(WithField ℝ PseudoAffine x, SimpleSpace (Needle x), Functor p) =>
p x -> NonEmpty (x, y) -> (x, ([(x, y)], [(x, y)]))
pseudoECM ([]::[x]) (NonEmpty (x, y) -> (x, ([(x, y)], [(x, y)])))
-> NonEmpty (x, y) -> (x, ([(x, y)], [(x, y)]))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [(x, y)] -> NonEmpty (x, y)
forall a. [a] -> NonEmpty a
NE.fromList [(x, y)]
ps
expa :: Maybe (Metric' x)
expa = ( (Metric' x -> Metric' x -> Metric' x
forall a. Semigroup a => a -> a -> a
<>Metric' x
minExt) (Metric' x -> Metric' x)
-> ([Needle x] -> Metric' x) -> [Needle x] -> Metric' x
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [Needle x] -> Metric' x
forall v. LSpace v => [v] -> Variance v
spanVariance ([Needle x] -> Metric' x)
-> ([Needle x] -> [Needle x]) -> [Needle x] -> Metric' x
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (Needle x -> Needle x) -> [Needle x] -> [Needle x]
forall a b. (a -> b) -> [a] -> [b]
map (Needle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ Int -> ℝ
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([(x, y)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(x, y)]
ps)) )
([Needle x] -> Metric' x) -> Maybe [Needle x] -> Maybe (Metric' x)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> ((x, y) -> Maybe (Needle x)) -> [(x, y)] -> Maybe [Needle x]
forall (s :: * -> *) (t :: * -> *) (k :: * -> * -> *)
(l :: * -> * -> *) (m :: * -> *) a b.
(Traversable s t k l, k ~ l, s ~ t, Applicative m k k, Object k a,
Object k (t a), ObjectPair k b (t b), ObjectPair k (m b) (m (t b)),
TraversalObject k t b) =>
k a (m b) -> k (t a) (m (t b))
mapM ((x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
ctr) (x -> Maybe (Needle x))
-> ((x, y) -> x) -> (x, y) -> Maybe (Needle x)
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (x, y) -> x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst) [(x, y)]
ps
shadesMerge :: ∀ x . (WithField ℝ Manifold x, SimpleSpace (Needle x))
=> ℝ
-> [Shade x]
-> [Shade x]
shadesMerge :: ℝ -> [Shade x] -> [Shade x]
shadesMerge ℝ
fuzz (sh :: Shade x
sh@(Shade x
c₁ Metric' x
e₁) : [Shade x]
shs)
= case (Shade x -> Maybe (Shade x))
-> [Shade x] -> (Maybe (Shade x), [Shade x])
forall a b. (a -> Maybe b) -> [a] -> (Maybe b, [a])
extractJust (PseudoAffineWitness x
-> DualNeedleWitness x -> Shade x -> Maybe (Shade x)
tryMerge PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness DualNeedleWitness x
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness)
[Shade x]
shs of
(Just Shade x
mg₁, [Shade x]
shs') -> ℝ -> [Shade x] -> [Shade x]
forall x.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
ℝ -> [Shade x] -> [Shade x]
shadesMerge ℝ
fuzz
([Shade x] -> [Shade x]) -> [Shade x] -> [Shade x]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [Shade x]
shs'[Shade x] -> [Shade x] -> [Shade x]
forall a. [a] -> [a] -> [a]
++[Shade x
mg₁]
(Maybe (Shade x)
_, [Shade x]
shs') -> Shade x
sh Shade x -> [Shade x] -> [Shade x]
forall a. a -> [a] -> [a]
: ℝ -> [Shade x] -> [Shade x]
forall x.
(WithField ℝ Manifold x, SimpleSpace (Needle x)) =>
ℝ -> [Shade x] -> [Shade x]
shadesMerge ℝ
fuzz [Shade x]
shs'
where tryMerge :: PseudoAffineWitness x -> DualNeedleWitness x
-> Shade x -> Maybe (Shade x)
tryMerge :: PseudoAffineWitness x
-> DualNeedleWitness x -> Shade x -> Maybe (Shade x)
tryMerge (PseudoAffineWitness (SemimanifoldWitness x
SemimanifoldWitness)) DualNeedleWitness x
DualSpaceWitness
(Shade x
c₂ Metric' x
e₂)
| Just Needle x
v <- x
c₁x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
c₂
, [Norm (Needle x)
e₁',Norm (Needle x)
e₂'] <- Metric' x -> Norm (Needle x)
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm(Metric' x -> Norm (Needle x)) -> [Metric' x] -> [Norm (Needle x)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[Metric' x
e₁, Metric' x
e₂]
, Scalar (Needle x)
b₁ <- Norm (Needle x)
e₂'Norm (Needle x) -> Needle x -> Scalar (Needle x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|Needle x
v
, Scalar (Needle x)
b₂ <- Norm (Needle x)
e₁'Norm (Needle x) -> Needle x -> Scalar (Needle x)
forall v.
(LSpace v, Floating (Scalar v)) =>
Seminorm v -> v -> Scalar v
|$|Needle x
v
, ℝ
fuzzℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
Scalar (Needle x)
b₁ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
Scalar (Needle x)
b₂ ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<= ℝ
Scalar (Needle x)
b₁ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
Scalar (Needle x)
b₂
= Shade x -> Maybe (Shade x)
forall a. a -> Maybe a
Just (Shade x -> Maybe (Shade x)) -> Shade x -> Maybe (Shade x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ let cc :: x
cc = x
c₂ x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle x
v Needle x -> ℝ -> Needle x
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ ℝ
2
Just Needle x
cv₁ = x
c₁x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
cc
Just Needle x
cv₂ = x
c₂x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
cc
in x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
cc (Metric' x -> Shade x) -> Metric' x -> Shade x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric' x
e₁ Metric' x -> Metric' x -> Metric' x
forall a. Semigroup a => a -> a -> a
<> Metric' x
e₂ Metric' x -> Metric' x -> Metric' x
forall a. Semigroup a => a -> a -> a
<> [Needle x] -> Metric' x
forall v. LSpace v => [v] -> Variance v
spanVariance [Needle x
cv₁, Needle x
cv₂]
| Bool
otherwise = Maybe (Shade x)
forall a. Maybe a
Nothing
shadesMerge ℝ
_ [Shade x]
shs = [Shade x]
shs
mixShade's :: ∀ y . (WithField ℝ Manifold y, SimpleSpace (Needle y))
=> NonEmpty (Shade' y) -> Maybe (Shade' y)
mixShade's :: NonEmpty (Shade' y) -> Maybe (Shade' y)
mixShade's = PseudoAffineWitness y
-> DualNeedleWitness y -> NonEmpty (Shade' y) -> Maybe (Shade' y)
ms PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness DualNeedleWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness
where ms :: PseudoAffineWitness y -> DualNeedleWitness y
-> NonEmpty (Shade' y) -> Maybe (Shade' y)
ms :: PseudoAffineWitness y
-> DualNeedleWitness y -> NonEmpty (Shade' y) -> Maybe (Shade' y)
ms (PseudoAffineWitness (SemimanifoldWitness y
SemimanifoldWitness)) DualNeedleWitness y
DualSpaceWitness
(Shade' y
c₀ (Norm Needle y -+> DualVector (Needle y)
e₁):|[Shade' y]
shs) = [Maybe (Needle y)] -> Maybe [Needle y]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [Maybe (Needle y)]
ciso Maybe [Needle y] -> Maybe (Shade' y) -> Maybe (Shade' y)
forall (k :: * -> * -> *) (m :: * -> *) b a.
(WellPointed k, Monad m k, ObjectPair k b (UnitObject k),
ObjectPair k (m b) (UnitObject k),
ObjectPair k (UnitObject k) (m b), ObjectPair k b a,
ObjectPair k a b, Object k (m (a, b)), ObjectPair k (m a) (m b),
ObjectPoint k (m a)) =>
m a -> k (m b) (m b)
>> Shade' y -> Maybe (Shade' y)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure Shade' y
mixed
where ciso :: [Maybe (Needle y)]
ciso = [y
ciy -> y -> Maybe (Needle y)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.y
c₀ | Shade' y
ci Norm (Needle y)
shi <- [Shade' y]
shs]
cis :: [Needle y]
cis = [Needle y
v | Just Needle y
v <- [Maybe (Needle y)]
ciso]
σe :: LinearMap ℝ (Needle y) (DualVector (Needle y))
σe = LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> LinearMap ℝ (Needle y) (DualVector (Needle y))
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> LinearMap ℝ (Needle y) (DualVector (Needle y)))
-> ([LinearFunction ℝ (Needle y) (DualVector (Needle y))]
-> LinearFunction ℝ (Needle y) (DualVector (Needle y)))
-> [LinearFunction ℝ (Needle y) (DualVector (Needle y))]
-> LinearMap ℝ (Needle y) (DualVector (Needle y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. [LinearFunction ℝ (Needle y) (DualVector (Needle y))]
-> LinearFunction ℝ (Needle y) (DualVector (Needle y))
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV ([LinearFunction ℝ (Needle y) (DualVector (Needle y))]
-> LinearMap ℝ (Needle y) (DualVector (Needle y)))
-> [LinearFunction ℝ (Needle y) (DualVector (Needle y))]
-> LinearMap ℝ (Needle y) (DualVector (Needle y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
e₁ LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> [LinearFunction ℝ (Needle y) (DualVector (Needle y))]
-> [LinearFunction ℝ (Needle y) (DualVector (Needle y))]
forall a. a -> [a] -> [a]
: (Norm (Needle y)
-> LinearFunction ℝ (Needle y) (DualVector (Needle y))
forall v. Norm v -> v -+> DualVector v
applyNorm (Norm (Needle y)
-> LinearFunction ℝ (Needle y) (DualVector (Needle y)))
-> (Shade' y -> Norm (Needle y))
-> Shade' y
-> LinearFunction ℝ (Needle y) (DualVector (Needle y))
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Shade' y -> Norm (Needle y)
forall x. Shade' x -> Metric x
_shade'Narrowness(Shade' y -> LinearFunction ℝ (Needle y) (DualVector (Needle y)))
-> [Shade' y]
-> [LinearFunction ℝ (Needle y) (DualVector (Needle y))]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[Shade' y]
shs)
cc :: Needle y
cc = LinearMap ℝ (Needle y) (DualVector (Needle y))
LinearMap (Scalar (Needle y)) (Needle y) (DualVector (Needle y))
σe LinearMap (Scalar (Needle y)) (Needle y) (DualVector (Needle y))
-> DualVector (Needle y) -> Needle y
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v -> u
\$ [DualVector (Needle y)] -> DualVector (Needle y)
forall (f :: * -> *) v. (Foldable f, AdditiveGroup v) => f v -> v
sumV [LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
ei LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> Needle y -> DualVector (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y
ci | Needle y
ci <- [Needle y]
cis
| Shade' y
_ (Norm Needle y -+> DualVector (Needle y)
ei) <- [Shade' y]
shs]
mixed :: Shade' y
mixed = y -> Norm (Needle y) -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' (y
c₀y -> Needle y -> y
+^Needle y
cc) (Norm (Needle y) -> Shade' y) -> Norm (Needle y) -> Shade' y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Norm (Needle y) -> Norm (Needle y)
forall v. LSpace v => Norm v -> Norm v
densifyNorm ( [Norm (Needle y)] -> Norm (Needle y)
forall a. Monoid a => [a] -> a
mconcat
[ (Needle y -+> DualVector (Needle y)) -> Norm (Needle y)
forall v. (v -+> DualVector v) -> Norm v
Norm ((Needle y -+> DualVector (Needle y)) -> Norm (Needle y))
-> (Needle y -+> DualVector (Needle y)) -> Norm (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y -+> DualVector (Needle y)
ei (Needle y -+> DualVector (Needle y))
-> ℝ -> Needle y -+> DualVector (Needle y)
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ (ℝ
1ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+(Norm (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Norm (Needle y)
ni (Needle y -> ℝ) -> Needle y -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y
ciNeedle y -> Needle y -> Needle y
forall v. AdditiveGroup v => v -> v -> v
^-^Needle y
cc))
| ni :: Norm (Needle y)
ni@(Norm Needle y -+> DualVector (Needle y)
ei) <- (Needle y -+> DualVector (Needle y)) -> Norm (Needle y)
forall v. (v -+> DualVector v) -> Norm v
Norm Needle y -+> DualVector (Needle y)
e₁ Norm (Needle y) -> [Norm (Needle y)] -> [Norm (Needle y)]
forall a. a -> [a] -> [a]
: (Shade' y -> Norm (Needle y)
forall x. Shade' x -> Metric x
_shade'Narrowness(Shade' y -> Norm (Needle y)) -> [Shade' y] -> [Norm (Needle y)]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[Shade' y]
shs)
| Needle y
ci <- Needle y
forall v. AdditiveGroup v => v
zeroV Needle y -> [Needle y] -> [Needle y]
forall a. a -> [a] -> [a]
: [Needle y]
cis
] )
+^ :: y -> Needle y -> y
(+^) = y -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
(.+~^)
minusLogOcclusion' :: ∀ x s . ( PseudoAffine x, LinearSpace (Needle x)
, s ~ (Scalar (Needle x)), RealFloat' s )
=> Shade' x -> x -> s
minusLogOcclusion' :: Shade' x -> x -> s
minusLogOcclusion' (Shade' x
p₀ Metric x
δinv)
= PseudoAffineWitness x -> DualSpaceWitness (Needle x) -> x -> s
occ (PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness x)
(DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x)
where occ :: PseudoAffineWitness x -> DualSpaceWitness (Needle x) -> x -> s
occ (PseudoAffineWitness (SemimanifoldWitness x
SemimanifoldWitness)) DualSpaceWitness (Needle x)
DualSpaceWitness
x
p = case x
px -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
p₀ of
(Just Needle x
vd) | Scalar (Needle x)
mSq <- Metric x -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric x
δinv Needle x
vd
, s
Scalar (Needle x)
mSq s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
Scalar (Needle x)
mSq
-> s
Scalar (Needle x)
mSq
Maybe (Needle x)
_ -> s
1s -> s -> s
forall a. Fractional a => a -> a -> a
/s
0
minusLogOcclusion :: ∀ x s . ( PseudoAffine x, SimpleSpace (Needle x)
, s ~ (Scalar (Needle x)), RealFloat' s )
=> Shade x -> x -> s
minusLogOcclusion :: Shade x -> x -> s
minusLogOcclusion (Shade x
p₀ Metric' x
δ)
= PseudoAffineWitness x -> DualSpaceWitness (Needle x) -> x -> s
occ (PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness x)
(DualSpaceWitness (Needle x)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x)
where occ :: PseudoAffineWitness x -> DualSpaceWitness (Needle x) -> x -> s
occ (PseudoAffineWitness (SemimanifoldWitness x
SemimanifoldWitness)) DualSpaceWitness (Needle x)
DualSpaceWitness
= \x
p -> case x
px -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
p₀ of
(Just Needle x
vd) | Scalar (Needle x)
mSq <- Seminorm (Needle x) -> Needle x -> Scalar (Needle x)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Variance (DualVector (Needle x))
Seminorm (Needle x)
δinv Needle x
vd
, s
Scalar (Needle x)
mSq s -> s -> Bool
forall a. Eq a => a -> a -> Bool
== s
Scalar (Needle x)
mSq
-> s
Scalar (Needle x)
mSq
Maybe (Needle x)
_ -> s
1s -> s -> s
forall a. Fractional a => a -> a -> a
/s
0
where δinv :: Variance (DualVector (Needle x))
δinv = Metric' x -> Variance (DualVector (Needle x))
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric' x
δ
rangeWithinVertices :: ∀ i m t s
. ( Geodesic i
, Geodesic m
, WithField s AffineManifold (Interior i)
, WithField s AffineManifold (Interior m)
, SimpleSpace (Needle (Interior i))
, SimpleSpace (Needle (Interior m))
, SimpleSpace (Needle' (Interior i))
, SimpleSpace (Needle' (Interior m))
, RealFrac' s
, Hask.Traversable t )
=> (Interior i,Interior m) -> t (i,m)
-> Maybe (Shade (Interior i) -> Shade (Interior m))
rangeWithinVertices :: (Interior i, Interior m)
-> t (i, m) -> Maybe (Shade (Interior i) -> Shade (Interior m))
rangeWithinVertices (Interior i
cii,Interior m
cmi) t (i, m)
verts = do
[(Diff (Interior i), Diff (Interior m))]
vs <- [Maybe (Diff (Interior i), Diff (Interior m))]
-> Maybe [(Diff (Interior i), Diff (Interior m))]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA [ (Maybe (Diff (Interior i)), Maybe (Diff (Interior m)))
-> Maybe (Diff (Interior i), Diff (Interior m))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Monoidal f r t, ObjectPair r a b, ObjectPair t (f a) (f b),
Object t (f (a, b))) =>
t (f a, f b) (f (a, b))
fzip ( i -> i -> Maybe i
forall x. Geodesic x => x -> x -> Maybe x
middleBetween i
pi i
ci Maybe i
-> (i -> Maybe (Diff (Interior i))) -> Maybe (Diff (Interior i))
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Function f, Monad m f, Object f a, Object f b, Object f (m a),
Object f (m b), Object f (m (m b))) =>
m a -> f a (m b) -> m b
>>= (i -> Maybe (Interior i)
forall m. SemimanifoldWithBoundary m => m -> Maybe (Interior m)
toInterior(i -> Maybe (Interior i))
-> (Interior i -> Maybe (Diff (Interior i)))
-> i
-> Maybe (Diff (Interior i))
forall (m :: * -> *) (k :: * -> * -> *) a b c.
(Monad m k, Object k a, Object k b, Object k c, Object k (m b),
Object k (m c), Object k (m (m c))) =>
k a (m b) -> k b (m c) -> k a (m c)
>=>(Interior i -> Interior i -> Maybe (Needle (Interior i))
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.Interior i
cii))
, m -> m -> Maybe m
forall x. Geodesic x => x -> x -> Maybe x
middleBetween m
pm m
cm Maybe m
-> (m -> Maybe (Diff (Interior m))) -> Maybe (Diff (Interior m))
forall (f :: * -> * -> *) (m :: * -> *) a b.
(Function f, Monad m f, Object f a, Object f b, Object f (m a),
Object f (m b), Object f (m (m b))) =>
m a -> f a (m b) -> m b
>>= (m -> Maybe (Interior m)
forall m. SemimanifoldWithBoundary m => m -> Maybe (Interior m)
toInterior(m -> Maybe (Interior m))
-> (Interior m -> Maybe (Diff (Interior m)))
-> m
-> Maybe (Diff (Interior m))
forall (m :: * -> *) (k :: * -> * -> *) a b c.
(Monad m k, Object k a, Object k b, Object k c, Object k (m b),
Object k (m c), Object k (m (m c))) =>
k a (m b) -> k b (m c) -> k a (m c)
>=>(Interior m -> Interior m -> Maybe (Needle (Interior m))
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.Interior m
cmi)) )
| (i
pi, m
pm) <- t (i, m) -> [(i, m)]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Hask.toList t (i, m)
verts ]
Embedding (Affine s) (Interior i) (Interior m)
affinSys <- (Interior i, Interior m)
-> [(Needle (Interior i), Needle (Interior m))]
-> Maybe (Embedding (Affine s) (Interior i) (Interior m))
forall x c (t :: * -> *) s.
(WithField s AffineManifold c, WithField s AffineManifold x,
SemiInner (Needle c), SemiInner (Needle x), RealFrac' s,
Traversable t) =>
(c, x)
-> t (Needle c, Needle x) -> Maybe (Embedding (Affine s) c x)
correspondingDirections @(Interior m) @(Interior i)
(Interior i
cii,Interior m
cmi) [(Diff (Interior i), Diff (Interior m))]
[(Needle (Interior i), Needle (Interior m))]
vs
(Shade (Interior i) -> Shade (Interior m))
-> Maybe (Shade (Interior i) -> Shade (Interior m))
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ((Shade (Interior i) -> Shade (Interior m))
-> Maybe (Shade (Interior i) -> Shade (Interior m)))
-> (Shade (Interior i) -> Shade (Interior m))
-> Maybe (Shade (Interior i) -> Shade (Interior m))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Embedding (Affine s) (Interior i) (Interior m)
-> Shade (Interior i) -> Shade (Interior m)
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SemiInner (Needle x),
SimpleSpace (Needle y)) =>
Embedding (Affine s) x y -> shade x -> shade y
embedShade Embedding (Affine s) (Interior i) (Interior m)
affinSys
where ci :: i
ci = Interior i -> i
forall m. SemimanifoldWithBoundary m => Interior m -> m
fromInterior Interior i
cii
cm :: m
cm = Interior m -> m
forall m. SemimanifoldWithBoundary m => Interior m -> m
fromInterior Interior m
cmi
data DebugView x where
DebugView :: ( Show x, Show (Needle x+>Needle' x), LinearShowable (Needle x)
, Needle' x ~ Needle x ) => DebugView x
class (WithField ℝ PseudoAffine y, SimpleSpace (Needle y)) => Refinable y where
debugView :: Maybe (DebugView y)
default debugView :: ( Show y, Show (Needle y+>Needle' y)
, Needle' y~Needle y, LinearShowable (Needle y) )
=> Maybe (DebugView y)
debugView = DebugView y -> Maybe (DebugView y)
forall a. a -> Maybe a
Just DebugView y
forall x.
(Show x, Show (Needle x +> Needle' x), LinearShowable (Needle x),
Needle' x ~ Needle x) =>
DebugView x
DebugView
subShade' :: Shade' y -> Shade' y -> Bool
subShade' (Shade' y
ac Metric y
ae) (Shade' y
tc Metric y
te)
= case PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness y of
PseudoAffineWitness (SemimanifoldWitness y
SemimanifoldWitness)
| Just Needle y
v <- y
tcy -> y -> Maybe (Needle y)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.y
ac
, Scalar (Needle y)
v² <- Metric y -> Needle y -> Scalar (Needle y)
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Metric y
te Needle y
v
, ℝ
Scalar (Needle y)
v² ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<= ℝ
1
-> ((DualVector (Needle y), Maybe ℝ) -> Bool)
-> [(DualVector (Needle y), Maybe ℝ)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\(DualVector (Needle y)
y',Maybe ℝ
μ) -> case Maybe ℝ
μ of
Maybe ℝ
Nothing -> Bool
True
Just ℝ
ξ
| ℝ
ξℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<ℝ
1 -> Bool
False
| ℝ
ω <- ℝ -> ℝ
forall a. Num a => a -> a
abs (ℝ -> ℝ) -> ℝ -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ DualVector (Needle y)
y'DualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
v
-> (ℝ
ω ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
ξ)ℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2 ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<= ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
Scalar (Needle y)
v² ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
ωℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2
) ([(DualVector (Needle y), Maybe ℝ)] -> Bool)
-> [(DualVector (Needle y), Maybe ℝ)] -> Bool
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Metric y
-> Metric y -> [(DualVector (Needle y), Maybe (Scalar (Needle y)))]
forall v.
SimpleSpace v =>
Seminorm v -> Seminorm v -> [(DualVector v, Maybe (Scalar v))]
sharedSeminormSpanningSystem Metric y
te Metric y
ae
PseudoAffineWitness y
_ -> Bool
False
refineShade' :: Shade' y -> Shade' y -> Maybe (Shade' y)
refineShade' (Shade' y
c₀ (Norm Needle y -+> DualVector (Needle y)
e₁)) (Shade' y
c₀₂ (Norm Needle y -+> DualVector (Needle y)
e₂))
= case ( DualSpaceWitness (Needle y)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness y
, PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness y ) of
(DualSpaceWitness (Needle y)
DualSpaceWitness, PseudoAffineWitness (SemimanifoldWitness y
SemimanifoldWitness))
-> do
Needle y
c₂ <- y
c₀₂y -> y -> Maybe (Needle y)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.y
c₀
let σe :: LinearMap ℝ (Needle y) (DualVector (Needle y))
σe = LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> LinearMap ℝ (Needle y) (DualVector (Needle y))
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> LinearMap ℝ (Needle y) (DualVector (Needle y)))
-> LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> LinearMap ℝ (Needle y) (DualVector (Needle y))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
e₁LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> LinearFunction ℝ (Needle y) (DualVector (Needle y))
forall v. AdditiveGroup v => v -> v -> v
^+^LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
e₂
e₁c₂ :: DualVector (Needle y)
e₁c₂ = LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
e₁ LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> Needle y -> DualVector (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y
c₂
e₂c₂ :: DualVector (Needle y)
e₂c₂ = LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
e₂ LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> Needle y -> DualVector (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y
c₂
cc :: Needle y
cc = LinearMap ℝ (Needle y) (DualVector (Needle y))
LinearMap (Scalar (Needle y)) (Needle y) (DualVector (Needle y))
σe LinearMap (Scalar (Needle y)) (Needle y) (DualVector (Needle y))
-> DualVector (Needle y) -> Needle y
forall u v.
(SimpleSpace u, SimpleSpace v, Scalar u ~ Scalar v) =>
(u +> v) -> v -> u
\$ DualVector (Needle y)
e₂c₂
cc₂ :: Needle y
cc₂ = Needle y
cc Needle y -> Needle y -> Needle y
forall v. AdditiveGroup v => v -> v -> v
^-^ Needle y
c₂
e₁cc :: DualVector (Needle y)
e₁cc = LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
e₁ LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> Needle y -> DualVector (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y
cc
e₂cc :: DualVector (Needle y)
e₂cc = LinearFunction ℝ (Needle y) (DualVector (Needle y))
Needle y -+> DualVector (Needle y)
e₂ LinearFunction ℝ (Needle y) (DualVector (Needle y))
-> Needle y -> DualVector (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y
cc
α :: ℝ
α = ℝ
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ DualVector (Needle y)
e₂c₂DualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
cc₂
Bool -> Maybe ()
forall (m :: * -> *) (k :: * -> * -> *).
(MonadPlus m k, Arrow k (->), Function k, UnitObject k ~ (),
Object k Bool) =>
k Bool (m ())
guard (ℝ
α ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0)
let ee :: LinearMap ℝ (Needle y) (DualVector (Needle y))
ee = LinearMap ℝ (Needle y) (DualVector (Needle y))
σe LinearMap ℝ (Needle y) (DualVector (Needle y))
-> ℝ -> LinearMap ℝ (Needle y) (DualVector (Needle y))
forall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ ℝ
α
c₂e₁c₂ :: Scalar (Needle y)
c₂e₁c₂ = DualVector (Needle y)
e₁c₂DualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
c₂
c₂e₂c₂ :: Scalar (Needle y)
c₂e₂c₂ = DualVector (Needle y)
e₂c₂DualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
c₂
c₂eec₂ :: ℝ
c₂eec₂ = (ℝ
Scalar (Needle y)
c₂e₁c₂ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
Scalar (Needle y)
c₂e₂c₂) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
α
Shade' y -> Maybe (Shade' y)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Shade' y -> Maybe (Shade' y)) -> Shade' y -> Maybe (Shade' y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ case [ℝ] -> [ℝ]
forall a. [a] -> [a]
middle ([ℝ] -> [ℝ]) -> ([ℝ] -> [ℝ]) -> [ℝ] -> [ℝ]
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. Ord a => [a] -> [a]
sort
([ℝ] -> [ℝ]) -> [ℝ] -> [ℝ]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> ℝ -> ℝ -> [ℝ]
forall a. (Ord a, Floating a) => a -> a -> a -> [a]
quadraticEqnSol ℝ
Scalar (Needle y)
c₂e₁c₂
(ℝ
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* (DualVector (Needle y)
e₁ccDualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
c₂))
(DualVector (Needle y)
e₁ccDualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
cc ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
1)
[ℝ] -> [ℝ] -> [ℝ]
forall a. [a] -> [a] -> [a]
++ℝ -> ℝ -> ℝ -> [ℝ]
forall a. (Ord a, Floating a) => a -> a -> a -> [a]
quadraticEqnSol ℝ
Scalar (Needle y)
c₂e₂c₂
(ℝ
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* (DualVector (Needle y)
e₂ccDualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
c₂ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
Scalar (Needle y)
c₂e₂c₂))
(DualVector (Needle y)
e₂ccDualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
cc ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* (DualVector (Needle y)
e₂c₂DualVector (Needle y) -> Needle y -> Scalar (Needle y)
forall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^Needle y
cc) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
Scalar (Needle y)
c₂e₂c₂ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
1) of
[ℝ
γ₁,ℝ
γ₂] | ℝ -> ℝ
forall a. Num a => a -> a
abs (ℝ
γ₁ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
γ₂) ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
< ℝ
2 -> let
cc' :: Needle y
cc' = Needle y
cc Needle y -> Needle y -> Needle y
forall v. AdditiveGroup v => v -> v -> v
^+^ ((ℝ
γ₁ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
γ₂)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2)Scalar (Needle y) -> Needle y -> Needle y
forall v. VectorSpace v => Scalar v -> v -> v
*^Needle y
c₂
rγ :: ℝ
rγ = ℝ -> ℝ
forall a. Num a => a -> a
abs (ℝ
γ₁ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
γ₂) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ ℝ
2
η :: ℝ
η = if ℝ
rγ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
c₂eec₂ ℝ -> ℝ -> Bool
forall a. Eq a => a -> a -> Bool
/= ℝ
0 Bool -> Bool -> Bool
&& ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
rγℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
c₂eec₂ ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
> ℝ
0
then ℝ -> ℝ
forall a. Floating a => a -> a
sqrt (ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
- ℝ
rγℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
c₂eec₂) ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ (ℝ
rγ ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
* ℝ
c₂eec₂)
else ℝ
0
in y -> Metric y -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' (y
c₀y -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
cc')
((Needle y -+> DualVector (Needle y)) -> Metric y
forall v. (v -+> DualVector v) -> Norm v
Norm (LinearMap ℝ (Needle y) (DualVector (Needle y))
-> LinearFunction ℝ (Needle y) (DualVector (Needle y))
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr LinearMap ℝ (Needle y) (DualVector (Needle y))
ee) Metric y -> Metric y -> Metric y
forall a. Semigroup a => a -> a -> a
<> [DualVector (Needle y)] -> Metric y
forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [LinearMap ℝ (Needle y) (DualVector (Needle y))
ee LinearMap ℝ (Needle y) (DualVector (Needle y))
-> Needle y -> DualVector (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle y
c₂Needle y -> ℝ -> Needle y
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*ℝ
η])
[ℝ]
_ -> y -> Metric y -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' (y
c₀y -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
cc) ((Needle y -+> DualVector (Needle y)) -> Metric y
forall v. (v -+> DualVector v) -> Norm v
Norm ((Needle y -+> DualVector (Needle y)) -> Metric y)
-> (Needle y -+> DualVector (Needle y)) -> Metric y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap ℝ (Needle y) (DualVector (Needle y))
-> Needle y -+> DualVector (Needle y)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr LinearMap ℝ (Needle y) (DualVector (Needle y))
ee)
where quadraticEqnSol :: a -> a -> a -> [a]
quadraticEqnSol a
a a
b a
c
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0, a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 = [-a
ca -> a -> a
forall a. Fractional a => a -> a -> a
/a
b]
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& a
disc a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
0 = [- a
b a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
a)]
| a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
0 Bool -> Bool -> Bool
&& a
disc a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = [ (a
σ a -> a -> a
forall a. Num a => a -> a -> a
* a -> a
forall a. Floating a => a -> a
sqrt a
disc a -> a -> a
forall a. Num a => a -> a -> a
- a
b) a -> a -> a
forall a. Fractional a => a -> a -> a
/ (a
2a -> a -> a
forall a. Num a => a -> a -> a
*a
a)
| a
σ <- [-a
1, a
1] ]
| Bool
otherwise = []
where disc :: a
disc = a
ba -> Int -> a
forall a. Num a => a -> Int -> a
^Int
2 a -> a -> a
forall a. Num a => a -> a -> a
- a
4a -> a -> a
forall a. Num a => a -> a -> a
*a
aa -> a -> a
forall a. Num a => a -> a -> a
*a
c
middle :: [a] -> [a]
middle (a
_:a
x:a
y:[a]
_) = [a
x,a
y]
middle [a]
l = [a]
l
convolveMetric :: Hask.Functor p => p y -> Metric y -> Metric y -> Metric y
convolveMetric p y
_ Metric y
ey Metric y
eδ = case Metric y -> Maybe (Metric y)
forall v. LinearSpace v => Norm v -> Maybe (Norm v)
wellDefinedNorm Metric y
result of
Just Metric y
r -> Metric y
r
Maybe (Metric y)
Nothing -> case Maybe (DebugView y)
forall y. Refinable y => Maybe (DebugView y)
debugView :: Maybe (DebugView y) of
Just DebugView y
DebugView -> String -> Metric y
forall a. HasCallStack => String -> a
error (String -> Metric y) -> String -> Metric y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ String
"Can not convolve norms "
String -> ShowS
forall a. [a] -> [a] -> [a]
++LinearMap ℝ (Needle y) (Needle y) -> String
forall a. Show a => a -> String
show (LinearFunction (Scalar (Needle y)) (Needle y) (Needle y)
-> LinearMap ℝ (Needle y) (Needle y)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (Metric y -> Needle y -+> DualVector (Needle y)
forall v. Norm v -> v -+> DualVector v
applyNorm Metric y
ey) :: Needle y+>Needle' y)
String -> ShowS
forall a. [a] -> [a] -> [a]
++String
" and "String -> ShowS
forall a. [a] -> [a] -> [a]
++LinearMap ℝ (Needle y) (Needle y) -> String
forall a. Show a => a -> String
show (LinearFunction (Scalar (Needle y)) (Needle y) (Needle y)
-> LinearMap ℝ (Needle y) (Needle y)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr (Metric y -> Needle y -+> DualVector (Needle y)
forall v. Norm v -> v -+> DualVector v
applyNorm Metric y
eδ) :: Needle y+>Needle' y)
where eδsp :: [(DualVector (Needle y), Maybe (Scalar (Needle y)))]
eδsp = Metric y
-> Metric y -> [(DualVector (Needle y), Maybe (Scalar (Needle y)))]
forall v.
SimpleSpace v =>
Seminorm v -> Seminorm v -> [(DualVector v, Maybe (Scalar v))]
sharedSeminormSpanningSystem Metric y
ey Metric y
eδ
result :: Metric y
result = [DualVector (Needle y)] -> Metric y
forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [ DualVector (Needle y)
f DualVector (Needle y) -> ℝ -> DualVector (Needle y)
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^* Maybe ℝ -> ℝ
Maybe (Scalar (Needle y)) -> ℝ
ζ Maybe (Scalar (Needle y))
crl | (DualVector (Needle y)
f,Maybe (Scalar (Needle y))
crl) <- [(DualVector (Needle y), Maybe (Scalar (Needle y)))]
eδsp ]
ζ :: Maybe ℝ -> ℝ
ζ = case (ℝ -> Bool) -> [ℝ] -> [ℝ]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(SumToProduct f r t, Object r a, Object r Bool, Object t (f a)) =>
r a Bool -> t (f a) (f a)
filter (ℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>ℝ
0) ([ℝ] -> [ℝ]) -> ([Maybe ℝ] -> [ℝ]) -> [Maybe ℝ] -> [ℝ]
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
. [Maybe ℝ] -> [ℝ]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ℝ] -> [ℝ]) -> [Maybe ℝ] -> [ℝ]
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (DualVector (Needle y), Maybe ℝ) -> Maybe ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((DualVector (Needle y), Maybe ℝ) -> Maybe ℝ)
-> [(DualVector (Needle y), Maybe ℝ)] -> [Maybe ℝ]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>[(DualVector (Needle y), Maybe ℝ)]
[(DualVector (Needle y), Maybe (Scalar (Needle y)))]
eδsp of
[] -> ℝ -> Maybe ℝ -> ℝ
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const ℝ
0
[ℝ]
nzrelap
-> let cre₁ :: ℝ
cre₁ = ℝ
1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/[ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [ℝ]
nzrelap
cre₂ :: ℝ
cre₂ = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [ℝ]
nzrelap
edgeFactor :: ℝ
edgeFactor = ℝ -> ℝ
forall a. Floating a => a -> a
sqrt ( (ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
cre₁)ℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ (ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
cre₂)ℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2 )
ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ (ℝ -> ℝ
forall a. Floating a => a -> a
sqrt (ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
cre₁ℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2) ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ -> ℝ
forall a. Floating a => a -> a
sqrt (ℝ
1 ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
cre₂ℝ -> Int -> ℝ
forall a. Num a => a -> Int -> a
^Int
2))
in \case
Maybe ℝ
Nothing -> ℝ
0
Just ℝ
0 -> ℝ
0
Just ℝ
sq -> ℝ
edgeFactor ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ (ℝ -> ℝ
forall a. Fractional a => a -> a
recip ℝ
sq ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ ℝ
1)
convolveShade' :: Shade' y -> Shade' (Needle y) -> Shade' y
convolveShade' = Shade' y -> Shade' (Needle y) -> Shade' y
forall y. Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
defaultConvolveShade'
defaultConvolveShade' :: ∀ y . Refinable y => Shade' y -> Shade' (Needle y) -> Shade' y
defaultConvolveShade' :: Shade' y -> Shade' (Needle y) -> Shade' y
defaultConvolveShade' = case (PseudoAffineWitness y
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness y) of
PseudoAffineWitness (SemimanifoldWitness y
SemimanifoldWitness)
-> \(Shade' y
y₀ Metric y
ey) (Shade' Needle y
δ₀ Metric (Needle y)
eδ) -> y -> Metric y -> Shade' y
forall x. x -> Metric x -> Shade' x
Shade' (y
y₀y -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
δ₀)
(Metric y -> Shade' y) -> Metric y -> Shade' y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ [y] -> Metric y -> Metric y -> Metric y
forall y (p :: * -> *).
(Refinable y, Functor p) =>
p y -> Metric y -> Metric y -> Metric y
convolveMetric ([]::[y]) Metric y
ey Metric y
Metric (Needle y)
eδ
instance Refinable ℝ where
refineShade' :: Shade' ℝ -> Shade' ℝ -> Maybe (Shade' ℝ)
refineShade' (Shade' ℝ
cl Metric ℝ
el) (Shade' ℝ
cr Metric ℝ
er)
= case (Seminorm ℝ -> ℝ -> Scalar ℝ
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Seminorm ℝ
Metric ℝ
el ℝ
1, Seminorm ℝ -> ℝ -> Scalar ℝ
forall v. LSpace v => Seminorm v -> v -> Scalar v
normSq Seminorm ℝ
Metric ℝ
er ℝ
1) of
(ℝ
0, ℝ
_) -> Shade' ℝ -> Maybe (Shade' ℝ)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Shade' ℝ -> Maybe (Shade' ℝ)) -> Shade' ℝ -> Maybe (Shade' ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> Metric ℝ -> Shade' ℝ
forall x. x -> Metric x -> Shade' x
Shade' ℝ
cr Metric ℝ
er
(ℝ
_, ℝ
0) -> Shade' ℝ -> Maybe (Shade' ℝ)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Shade' ℝ -> Maybe (Shade' ℝ)) -> Shade' ℝ -> Maybe (Shade' ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> Metric ℝ -> Shade' ℝ
forall x. x -> Metric x -> Shade' x
Shade' ℝ
cl Metric ℝ
el
(ℝ
ql,ℝ
qr) | ℝ
qlℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>ℝ
0, ℝ
qrℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>ℝ
0
-> let [ℝ
rl,ℝ
rr] = ℝ -> ℝ
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. Fractional a => a -> a
recip (ℝ -> ℝ) -> [ℝ] -> [ℝ]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> [ℝ
ql,ℝ
qr]
b :: ℝ
b = [ℝ] -> ℝ
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
$ (ℝ -> ℝ -> ℝ) -> [ℝ] -> [ℝ] -> [ℝ]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [ℝ
cl,ℝ
cr] [ℝ
rl,ℝ
rr]
t :: ℝ
t = [ℝ] -> ℝ
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([ℝ] -> ℝ) -> [ℝ] -> ℝ
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ℝ -> ℝ -> ℝ) -> [ℝ] -> [ℝ] -> [ℝ]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith ℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
(+) [ℝ
cl,ℝ
cr] [ℝ
rl,ℝ
rr]
in Bool -> Maybe ()
forall (m :: * -> *) (k :: * -> * -> *).
(MonadPlus m k, Arrow k (->), Function k, UnitObject k ~ (),
Object k Bool) =>
k Bool (m ())
guard (ℝ
bℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
<ℝ
t) Maybe () -> Maybe (Shade' ℝ) -> Maybe (Shade' ℝ)
forall (k :: * -> * -> *) (m :: * -> *) b a.
(WellPointed k, Monad m k, ObjectPair k b (UnitObject k),
ObjectPair k (m b) (UnitObject k),
ObjectPair k (UnitObject k) (m b), ObjectPair k b a,
ObjectPair k a b, Object k (m (a, b)), ObjectPair k (m a) (m b),
ObjectPoint k (m a)) =>
m a -> k (m b) (m b)
>>
let cm :: ℝ
cm = (ℝ
bℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
+ℝ
t)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2
rm :: ℝ
rm = (ℝ
tℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
-ℝ
b)ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2
in Shade' ℝ -> Maybe (Shade' ℝ)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return (Shade' ℝ -> Maybe (Shade' ℝ)) -> Shade' ℝ -> Maybe (Shade' ℝ)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ℝ -> Metric ℝ -> Shade' ℝ
forall x. x -> Metric x -> Shade' x
Shade' ℝ
cm ([DualVector ℝ] -> Seminorm ℝ
forall v. LSpace v => [DualVector v] -> Seminorm v
spanNorm [ℝ -> ℝ
forall a. Fractional a => a -> a
recip ℝ
rm])
instance ∀ a b . ( Refinable a, Refinable b
, Scalar (DualVector (DualVector (Needle b)))
~ Scalar (DualVector (DualVector (Needle a))) )
=> Refinable (a,b) where
debugView :: Maybe (DebugView (a, b))
debugView = case ( Maybe (DebugView a)
forall y. Refinable y => Maybe (DebugView y)
debugView :: Maybe (DebugView a)
, Maybe (DebugView b)
forall y. Refinable y => Maybe (DebugView y)
debugView :: Maybe (DebugView b)
, DualSpaceWitness (Needle a)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle a)
, DualSpaceWitness (Needle b)
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle b) ) of
(Just DebugView a
DebugView, Just DebugView b
DebugView, DualSpaceWitness (Needle a)
DualSpaceWitness, DualSpaceWitness (Needle b)
DualSpaceWitness)
-> DebugView (a, b) -> Maybe (DebugView (a, b))
forall a. a -> Maybe a
Just DebugView (a, b)
forall x.
(Show x, Show (Needle x +> Needle' x), LinearShowable (Needle x),
Needle' x ~ Needle x) =>
DebugView x
DebugView
instance Refinable ℝ⁰
instance Refinable ℝ¹
instance Refinable ℝ²
instance Refinable ℝ³
instance Refinable ℝ⁴
instance ( SimpleSpace a, SimpleSpace b
, Refinable a, Refinable b
, Scalar a ~ ℝ, Scalar b ~ ℝ
, Scalar (DualVector a) ~ ℝ, Scalar (DualVector b) ~ ℝ
, Scalar (DualVector (DualVector a)) ~ ℝ, Scalar (DualVector (DualVector b)) ~ ℝ )
=> Refinable (LinearMap ℝ a b) where
debugView :: Maybe (DebugView (LinearMap ℝ a b))
debugView = Maybe (DebugView (LinearMap ℝ a b))
forall a. Maybe a
Nothing
intersectShade's :: ∀ y . Refinable y => NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's :: NonEmpty (Shade' y) -> Maybe (Shade' y)
intersectShade's (Shade' y
sh:|[Shade' y]
shs) = (Shade' y -> Shade' y -> Maybe (Shade' y))
-> Shade' y -> [Shade' y] -> Maybe (Shade' y)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> b -> m b) -> b -> t a -> m b
Hask.foldrM Shade' y -> Shade' y -> Maybe (Shade' y)
forall y. Refinable y => Shade' y -> Shade' y -> Maybe (Shade' y)
refineShade' Shade' y
sh [Shade' y]
shs
data x`WithAny`y
= WithAny { WithAny x y -> y
_untopological :: y
, WithAny x y -> x
_topological :: !x }
deriving (a -> WithAny x b -> WithAny x a
(a -> b) -> WithAny x a -> WithAny x b
(forall a b. (a -> b) -> WithAny x a -> WithAny x b)
-> (forall a b. a -> WithAny x b -> WithAny x a)
-> Functor (WithAny x)
forall a b. a -> WithAny x b -> WithAny x a
forall a b. (a -> b) -> WithAny x a -> WithAny x b
forall x a b. a -> WithAny x b -> WithAny x a
forall x a b. (a -> b) -> WithAny x a -> WithAny x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithAny x b -> WithAny x a
$c<$ :: forall x a b. a -> WithAny x b -> WithAny x a
fmap :: (a -> b) -> WithAny x a -> WithAny x b
$cfmap :: forall x a b. (a -> b) -> WithAny x a -> WithAny x b
Hask.Functor, Int -> WithAny x y -> ShowS
[WithAny x y] -> ShowS
WithAny x y -> String
(Int -> WithAny x y -> ShowS)
-> (WithAny x y -> String)
-> ([WithAny x y] -> ShowS)
-> Show (WithAny x y)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall x y. (Show y, Show x) => Int -> WithAny x y -> ShowS
forall x y. (Show y, Show x) => [WithAny x y] -> ShowS
forall x y. (Show y, Show x) => WithAny x y -> String
showList :: [WithAny x y] -> ShowS
$cshowList :: forall x y. (Show y, Show x) => [WithAny x y] -> ShowS
show :: WithAny x y -> String
$cshow :: forall x y. (Show y, Show x) => WithAny x y -> String
showsPrec :: Int -> WithAny x y -> ShowS
$cshowsPrec :: forall x y. (Show y, Show x) => Int -> WithAny x y -> ShowS
Show, (forall x. WithAny x y -> Rep (WithAny x y) x)
-> (forall x. Rep (WithAny x y) x -> WithAny x y)
-> Generic (WithAny x y)
forall x. Rep (WithAny x y) x -> WithAny x y
forall x. WithAny x y -> Rep (WithAny x y) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall x y x. Rep (WithAny x y) x -> WithAny x y
forall x y x. WithAny x y -> Rep (WithAny x y) x
$cto :: forall x y x. Rep (WithAny x y) x -> WithAny x y
$cfrom :: forall x y x. WithAny x y -> Rep (WithAny x y) x
Generic)
instance (NFData x, NFData y) => NFData (WithAny x y)
instance ∀ x y . (Semimanifold x) => Semimanifold (x`WithAny`y) where
type Needle (WithAny x y) = Needle x
WithAny y
y x
x .+~^ :: WithAny x y -> Needle (WithAny x y) -> WithAny x y
.+~^ Needle (WithAny x y)
δx = y -> x -> WithAny x y
forall x y. y -> x -> WithAny x y
WithAny y
y (x -> WithAny x y) -> x -> WithAny x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
xx -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle x
Needle (WithAny x y)
δx
semimanifoldWitness :: SemimanifoldWitness (WithAny x y)
semimanifoldWitness = case SemimanifoldWitness x
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness x of
SemimanifoldWitness x
SemimanifoldWitness -> SemimanifoldWitness (WithAny x y)
forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness
instance (PseudoAffine x) => PseudoAffine (x`WithAny`y) where
WithAny y
_ x
x .-~! :: WithAny x y -> WithAny x y -> Needle (WithAny x y)
.-~! WithAny y
_ x
ξ = x
xx -> x -> Needle x
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!x
ξ
WithAny y
_ x
x .-~. :: WithAny x y -> WithAny x y -> Maybe (Needle (WithAny x y))
.-~. WithAny y
_ x
ξ = x
xx -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~.x
ξ
pseudoAffineWitness :: PseudoAffineWitness (WithAny x y)
pseudoAffineWitness = case PseudoAffineWitness x
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness :: PseudoAffineWitness x of
PseudoAffineWitness (SemimanifoldWitness x
SemimanifoldWitness)
-> SemimanifoldWitness (WithAny x y)
-> PseudoAffineWitness (WithAny x y)
forall x.
PseudoAffine (Needle x) =>
SemimanifoldWitness x -> PseudoAffineWitness x
PseudoAffineWitness (SemimanifoldWitness (WithAny x y)
forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness)
instance (AffineSpace x) => AffineSpace (x`WithAny`y) where
type Diff (WithAny x y) = Diff x
WithAny y
_ x
x .-. :: WithAny x y -> WithAny x y -> Diff (WithAny x y)
.-. WithAny y
_ x
ξ = x
xx -> x -> Diff x
forall p. AffineSpace p => p -> p -> Diff p
.-.x
ξ
WithAny y
y x
x .+^ :: WithAny x y -> Diff (WithAny x y) -> WithAny x y
.+^ Diff (WithAny x y)
δx = y -> x -> WithAny x y
forall x y. y -> x -> WithAny x y
WithAny y
y (x -> WithAny x y) -> x -> WithAny x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
xx -> Diff x -> x
forall p. AffineSpace p => p -> Diff p -> p
.+^Diff x
Diff (WithAny x y)
δx
instance (VectorSpace x, Monoid y) => VectorSpace (x`WithAny`y) where
type Scalar (WithAny x y) = Scalar x
Scalar (WithAny x y)
μ *^ :: Scalar (WithAny x y) -> WithAny x y -> WithAny x y
*^ WithAny y
y x
x = y -> x -> WithAny x y
forall x y. y -> x -> WithAny x y
WithAny y
y (x -> WithAny x y) -> x -> WithAny x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Scalar x
Scalar (WithAny x y)
μScalar x -> x -> x
forall v. VectorSpace v => Scalar v -> v -> v
*^x
x
instance (AdditiveGroup x, Monoid y) => AdditiveGroup (x`WithAny`y) where
zeroV :: WithAny x y
zeroV = y -> x -> WithAny x y
forall x y. y -> x -> WithAny x y
WithAny y
forall a. Monoid a => a
mempty x
forall v. AdditiveGroup v => v
zeroV
negateV :: WithAny x y -> WithAny x y
negateV (WithAny y
y x
x) = y -> x -> WithAny x y
forall x y. y -> x -> WithAny x y
WithAny y
y (x -> WithAny x y) -> x -> WithAny x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x -> x
forall v. AdditiveGroup v => v -> v
negateV x
x
WithAny y
y x
x ^+^ :: WithAny x y -> WithAny x y -> WithAny x y
^+^ WithAny y
υ x
ξ = y -> x -> WithAny x y
forall x y. y -> x -> WithAny x y
WithAny (y -> y -> y
forall a. Monoid a => a -> a -> a
mappend y
y y
υ) (x
xx -> x -> x
forall v. AdditiveGroup v => v -> v -> v
^+^x
ξ)
instance (AdditiveGroup x) => Hask.Applicative (WithAny x) where
pure :: a -> WithAny x a
pure a
x = a -> x -> WithAny x a
forall x y. y -> x -> WithAny x y
WithAny a
x x
forall v. AdditiveGroup v => v
zeroV
WithAny a -> b
f x
x <*> :: WithAny x (a -> b) -> WithAny x a -> WithAny x b
<*> WithAny a
t x
ξ = b -> x -> WithAny x b
forall x y. y -> x -> WithAny x y
WithAny (a -> b
f a
t) (x
xx -> x -> x
forall v. AdditiveGroup v => v -> v -> v
^+^x
ξ)
instance (AdditiveGroup x) => Hask.Monad (WithAny x) where
return :: a -> WithAny x a
return a
x = a -> x -> WithAny x a
forall x y. y -> x -> WithAny x y
WithAny a
x x
forall v. AdditiveGroup v => v
zeroV
WithAny a
y x
x >>= :: WithAny x a -> (a -> WithAny x b) -> WithAny x b
>>= a -> WithAny x b
f = b -> x -> WithAny x b
forall x y. y -> x -> WithAny x y
WithAny b
r (x -> WithAny x b) -> x -> WithAny x b
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
xx -> x -> x
forall v. AdditiveGroup v => v -> v -> v
^+^x
q
where WithAny b
r x
q = a -> WithAny x b
f a
y
shadeWithAny :: y -> Shade x -> Shade (x`WithAny`y)
shadeWithAny :: y -> Shade x -> Shade (WithAny x y)
shadeWithAny y
y (Shade x
x Metric' x
xe) = WithAny x y -> Metric' (WithAny x y) -> Shade (WithAny x y)
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade (y -> x -> WithAny x y
forall x y. y -> x -> WithAny x y
WithAny y
y x
x) Metric' x
Metric' (WithAny x y)
xe
shadeWithoutAnything :: Semimanifold x => Shade (x`WithAny`y) -> Shade x
shadeWithoutAnything :: Shade (WithAny x y) -> Shade x
shadeWithoutAnything (Shade (WithAny y
_ x
b) Metric' (WithAny x y)
e) = x -> Metric' x -> Shade x
forall x.
(Semimanifold x, SimpleSpace (Needle x)) =>
x -> Metric' x -> Shade x
Shade x
b Metric' x
Metric' (WithAny x y)
e
extractJust :: (a->Maybe b) -> [a] -> (Maybe b, [a])
a -> Maybe b
f [] = (Maybe b
forall a. Maybe a
Nothing,[])
extractJust a -> Maybe b
f (a
x:[a]
xs) | Just b
r <- a -> Maybe b
f a
x = (b -> Maybe b
forall a. a -> Maybe a
Just b
r, [a]
xs)
| Bool
otherwise = ([a] -> [a]) -> (Maybe b, [a]) -> (Maybe b, [a])
forall (a :: * -> * -> *) d b c.
(Morphism a, ObjectPair a d b, ObjectPair a d c) =>
a b c -> a (d, b) (d, c)
second (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) ((Maybe b, [a]) -> (Maybe b, [a]))
-> (Maybe b, [a]) -> (Maybe b, [a])
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (a -> Maybe b) -> [a] -> (Maybe b, [a])
forall a b. (a -> Maybe b) -> [a] -> (Maybe b, [a])
extractJust a -> Maybe b
f [a]
xs
prettyShowShade' :: LtdErrorShow x => Shade' x -> String
prettyShowShade' :: Shade' x -> String
prettyShowShade' Shade' x
sh = Int -> Shade' x -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
prettyShowsPrecShade' Int
0 Shade' x
sh []
instance LtdErrorShow x => SP.Show (Shade' x) where
showsPrec :: Int -> Shade' x -> ShowS
showsPrec = Int -> Shade' x -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
prettyShowsPrecShade'
instance LtdErrorShow x => SP.Show (Shade x) where
showsPrec :: Int -> Shade x -> ShowS
showsPrec = Int -> Shade x -> ShowS
forall x. LtdErrorShow x => Int -> Shade x -> ShowS
prettyShowsPrecShade
wellDefinedShade' :: LinearSpace (Needle x) => Shade' x -> Maybe (Shade' x)
wellDefinedShade' :: Shade' x -> Maybe (Shade' x)
wellDefinedShade' (Shade' x
c Metric x
e) = x -> Metric x -> Shade' x
forall x. x -> Metric x -> Shade' x
Shade' x
c (Metric x -> Shade' x) -> Maybe (Metric x) -> Maybe (Shade' x)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Metric x -> Maybe (Metric x)
forall v. LinearSpace v => Norm v -> Maybe (Norm v)
wellDefinedNorm Metric x
e
data LtdErrorShowWitness m where
LtdErrorShowWitness :: (LtdErrorShow m, LtdErrorShow (Needle m))
=> PseudoAffineWitness m -> LtdErrorShowWitness m
class Refinable m => LtdErrorShow m where
ltdErrorShowWitness :: LtdErrorShowWitness m
default ltdErrorShowWitness :: (LtdErrorShow m, LtdErrorShow (Needle m))
=> LtdErrorShowWitness m
ltdErrorShowWitness = PseudoAffineWitness m -> LtdErrorShowWitness m
forall m.
(LtdErrorShow m, LtdErrorShow (Needle m)) =>
PseudoAffineWitness m -> LtdErrorShowWitness m
LtdErrorShowWitness PseudoAffineWitness m
forall x. PseudoAffine x => PseudoAffineWitness x
pseudoAffineWitness
showsPrecShade'_errorLtdC :: Int -> Shade' m -> ShowS
prettyShowsPrecShade :: Int -> Shade m -> ShowS
prettyShowsPrecShade Int
p sh :: Shade m
sh@(Shade m
c Metric' m
e')
= Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
6) (ShowS -> ShowS) -> ShowS -> ShowS
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ShowS
v
ShowS -> ShowS -> ShowS
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
. (String
":±["String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. (String -> [ShowS] -> String) -> [ShowS] -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ShowS -> ShowS) -> String -> [ShowS] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:) [ShowS]
u) ShowS -> ShowS -> ShowS
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
. (Char
']'Char -> ShowS
forall a. a -> [a] -> [a]
:)
where v :: ShowS
v = Int -> Shade' m -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
6 (m -> Metric m -> Shade' m
forall x. x -> Metric x -> Shade' x
Shade' m
c Metric m
e :: Shade' m)
[ShowS]
u :: [ShowS] = case LtdErrorShowWitness m
forall m. LtdErrorShow m => LtdErrorShowWitness m
ltdErrorShowWitness :: LtdErrorShowWitness m of
LtdErrorShowWitness (PseudoAffineWitness SemimanifoldWitness m
SemimanifoldWitness) ->
[ Int -> Shade' (Needle m) -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
6 (Needle m -> Metric (Needle m) -> Shade' (Needle m)
forall x. x -> Metric x -> Shade' x
Shade' Needle m
δ Metric m
Metric (Needle m)
e :: Shade' (Needle m))
| Needle m
δ <- Metric' m -> [Needle m]
forall v. SimpleSpace v => Variance v -> [v]
varianceSpanningSystem Metric' m
e']
e :: Metric m
e = Metric' m -> Metric m
forall v. SimpleSpace v => Variance v -> Norm v
dualNorm' Metric' m
e'
prettyShowsPrecShade' :: Int -> Shade' m -> ShowS
prettyShowsPrecShade' Int
p sh :: Shade' m
sh@(Shade' m
c Metric m
e)
= Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
6) (ShowS -> ShowS) -> ShowS -> ShowS
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ShowS
v
ShowS -> ShowS -> ShowS
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
. (String
"|±|["String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. (String -> [ShowS] -> String) -> [ShowS] -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((ShowS -> ShowS) -> String -> [ShowS] -> String
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id) (ShowS -> [ShowS] -> [ShowS]
forall a. a -> [a] -> [a]
intersperse (Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:) [ShowS]
u) ShowS -> ShowS -> ShowS
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
. (Char
']'Char -> ShowS
forall a. a -> [a] -> [a]
:)
where v :: ShowS
v = Int -> Shade' m -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
6 Shade' m
sh
[ShowS]
u :: [ShowS] = case LtdErrorShowWitness m
forall m. LtdErrorShow m => LtdErrorShowWitness m
ltdErrorShowWitness :: LtdErrorShowWitness m of
LtdErrorShowWitness (PseudoAffineWitness SemimanifoldWitness m
SemimanifoldWitness) ->
[ Int -> Shade' (Needle m) -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
6 (Needle m -> Metric (Needle m) -> Shade' (Needle m)
forall x. x -> Metric x -> Shade' x
Shade' Needle m
δ Metric m
Metric (Needle m)
e :: Shade' (Needle m))
| Needle m
δ <- Metric' m -> [Needle m]
forall v. SimpleSpace v => Variance v -> [v]
varianceSpanningSystem Metric' m
e']
e' :: Metric' m
e' = Metric m -> Metric' m
forall v. SimpleSpace v => Norm v -> Variance v
dualNorm Metric m
e
instance LtdErrorShow ℝ⁰ where
showsPrecShade'_errorLtdC :: Int -> Shade' ℝ⁰ -> ShowS
showsPrecShade'_errorLtdC Int
_ Shade' ℝ⁰
_ = (String
"zeroV"String -> ShowS
forall a. [a] -> [a] -> [a]
++)
instance LtdErrorShow ℝ where
showsPrecShade'_errorLtdC :: Int -> Shade' ℝ -> ShowS
showsPrecShade'_errorLtdC Int
_ (Shade' ℝ
v Metric ℝ
u) = ℝ -> ℝ -> ShowS
forall n. RealFloat n => n -> n -> ShowS
errorLtdShow (ℝ
δℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
2) ℝ
v
where δ :: ℝ
δ = case Seminorm ℝ
Metric ℝ
uSeminorm ℝ -> ℝ -> DualVector ℝ
forall v. LSpace v => Norm v -> v -> DualVector v
<$|ℝ
1 of
DualVector ℝ
σ | ℝ
DualVector ℝ
σℝ -> ℝ -> Bool
forall a. Ord a => a -> a -> Bool
>ℝ
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
$ ℝ
1ℝ -> ℝ -> ℝ
forall a. Fractional a => a -> a -> a
/ℝ
DualVector ℝ
σ
DualVector ℝ
_ -> ℝ
vℝ -> ℝ -> ℝ
forall a. Num a => a -> a -> a
*ℝ
10
instance LtdErrorShow ℝ² where
showsPrecShade'_errorLtdC :: Int -> Shade' ℝ² -> ShowS
showsPrecShade'_errorLtdC Int
_ Shade' ℝ²
sh = (String
"V2 "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. ShowS
shshx ShowS -> ShowS -> ShowS
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
. (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshy
where shx :: Shade' ℝ
shx = Embedding (Affine ℝ) ℝ ℝ² -> Shade' ℝ² -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ² ℝ -> Embedding (Affine ℝ) ℝ ℝ²
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ² ℝ
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) Shade' ℝ²
sh :: Shade' ℝ
shy :: Shade' ℝ
shy = Embedding (Affine ℝ) ℝ ℝ² -> Shade' ℝ² -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ² ℝ -> Embedding (Affine ℝ) ℝ ℝ²
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ² ℝ
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) Shade' ℝ²
sh :: Shade' ℝ
shshx :: ShowS
shshx = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shx
shshy :: ShowS
shshy = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shy
instance LtdErrorShow ℝ³ where
showsPrecShade'_errorLtdC :: Int -> Shade' ℝ³ -> ShowS
showsPrecShade'_errorLtdC Int
_ Shade' ℝ³
sh = (String
"V3 "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. ShowS
shshx ShowS -> ShowS -> ShowS
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
. (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshy ShowS -> ShowS -> ShowS
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
. (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshz
where shx :: Shade' ℝ
shx = Embedding (Affine ℝ) ℝ ℝ³ -> Shade' ℝ³ -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ³ ℝ -> Embedding (Affine ℝ) ℝ ℝ³
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ³ ℝ
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) Shade' ℝ³
sh :: Shade' ℝ
shy :: Shade' ℝ
shy = Embedding (Affine ℝ) ℝ ℝ³ -> Shade' ℝ³ -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ³ ℝ -> Embedding (Affine ℝ) ℝ ℝ³
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ³ ℝ
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) Shade' ℝ³
sh :: Shade' ℝ
shz :: Shade' ℝ
shz = Embedding (Affine ℝ) ℝ ℝ³ -> Shade' ℝ³ -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ³ ℝ -> Embedding (Affine ℝ) ℝ ℝ³
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ³ ℝ
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z) Shade' ℝ³
sh :: Shade' ℝ
shshx :: ShowS
shshx = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shx
shshy :: ShowS
shshy = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shy
shshz :: ShowS
shshz = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shz
instance LtdErrorShow ℝ⁴ where
showsPrecShade'_errorLtdC :: Int -> Shade' ℝ⁴ -> ShowS
showsPrecShade'_errorLtdC Int
_ Shade' ℝ⁴
sh
= (String
"V4 "String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. ShowS
shshx ShowS -> ShowS -> ShowS
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
. (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshy ShowS -> ShowS -> ShowS
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
. (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshz ShowS -> ShowS -> ShowS
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
. (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshw
where shx :: Shade' ℝ
shx = Embedding (Affine ℝ) ℝ ℝ⁴ -> Shade' ℝ⁴ -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ⁴ ℝ -> Embedding (Affine ℝ) ℝ ℝ⁴
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ⁴ ℝ
forall (t :: * -> *) a. R1 t => Lens' (t a) a
_x) Shade' ℝ⁴
sh :: Shade' ℝ
shy :: Shade' ℝ
shy = Embedding (Affine ℝ) ℝ ℝ⁴ -> Shade' ℝ⁴ -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ⁴ ℝ -> Embedding (Affine ℝ) ℝ ℝ⁴
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ⁴ ℝ
forall (t :: * -> *) a. R2 t => Lens' (t a) a
_y) Shade' ℝ⁴
sh :: Shade' ℝ
shz :: Shade' ℝ
shz = Embedding (Affine ℝ) ℝ ℝ⁴ -> Shade' ℝ⁴ -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ⁴ ℝ -> Embedding (Affine ℝ) ℝ ℝ⁴
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ⁴ ℝ
forall (t :: * -> *) a. R3 t => Lens' (t a) a
_z) Shade' ℝ⁴
sh :: Shade' ℝ
shw :: Shade' ℝ
shw = Embedding (Affine ℝ) ℝ ℝ⁴ -> Shade' ℝ⁴ -> Shade' ℝ
forall (shade :: * -> *) x y s.
(IsShade shade, Semimanifold x, Semimanifold y,
Object (Affine s) x, Object (Affine s) y, SimpleSpace (Needle x),
SemiInner (Needle y)) =>
Embedding (Affine s) x y -> shade y -> shade x
projectShade (Lens' ℝ⁴ ℝ -> Embedding (Affine ℝ) ℝ ℝ⁴
forall (k :: * -> * -> *) x c s.
(Num' s, LinearSpace x, LinearSpace c, Object k x, Object k c,
Scalar x ~ s, Scalar c ~ s, EnhancedCat k (LinearMap s)) =>
Lens' x c -> Embedding k c x
lensEmbedding Lens' ℝ⁴ ℝ
forall (t :: * -> *) a. R4 t => Lens' (t a) a
_w) Shade' ℝ⁴
sh :: Shade' ℝ
shshx :: ShowS
shshx = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shx
shshy :: ShowS
shshy = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shy
shshz :: ShowS
shshz = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shz
shshw :: ShowS
shshw = Int -> Shade' ℝ -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' ℝ
shw
instance ∀ x y .
( LtdErrorShow x, LtdErrorShow y
, Scalar (DualVector (Needle' x)) ~ Scalar (DualVector (Needle' y)) )
=> LtdErrorShow (x,y) where
ltdErrorShowWitness :: LtdErrorShowWitness (x, y)
ltdErrorShowWitness = case ( LtdErrorShowWitness x
forall m. LtdErrorShow m => LtdErrorShowWitness m
ltdErrorShowWitness :: LtdErrorShowWitness x
, LtdErrorShowWitness y
forall m. LtdErrorShow m => LtdErrorShowWitness m
ltdErrorShowWitness :: LtdErrorShowWitness y ) of
( LtdErrorShowWitness(PseudoAffineWitness(SemimanifoldWitness x
SemimanifoldWitness))
, LtdErrorShowWitness(PseudoAffineWitness(SemimanifoldWitness y
SemimanifoldWitness)) )
->PseudoAffineWitness (x, y) -> LtdErrorShowWitness (x, y)
forall m.
(LtdErrorShow m, LtdErrorShow (Needle m)) =>
PseudoAffineWitness m -> LtdErrorShowWitness m
LtdErrorShowWitness(SemimanifoldWitness (x, y) -> PseudoAffineWitness (x, y)
forall x.
PseudoAffine (Needle x) =>
SemimanifoldWitness x -> PseudoAffineWitness x
PseudoAffineWitness(SemimanifoldWitness (x, y)
forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness))
showsPrecShade'_errorLtdC :: Int -> Shade' (x, y) -> ShowS
showsPrecShade'_errorLtdC Int
_ Shade' (x, y)
sh = (Char
'('Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshx ShowS -> ShowS -> ShowS
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
. (Char
','Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> ShowS -> ShowS
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
. ShowS
shshy ShowS -> ShowS -> ShowS
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
. (Char
')'Char -> ShowS
forall a. a -> [a] -> [a]
:)
where (Shade' x
shx,Shade' y
shy) = Shade' (x, y) -> (Shade' x, Shade' y)
forall (shade :: * -> *) x y.
(IsShade shade, PseudoAffine x, SimpleSpace (Needle x),
PseudoAffine y, SimpleSpace (Needle y),
Scalar (Needle x) ~ Scalar (Needle y)) =>
shade (x, y) -> (shade x, shade y)
factoriseShade Shade' (x, y)
sh
shshx :: ShowS
shshx = Int -> Shade' x -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' x
shx
shshy :: ShowS
shshy = Int -> Shade' y -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
0 Shade' y
shy
instance ∀ v .
(HilbertSpace v, SemiInner v, FiniteDimensional v, LtdErrorShow v, Scalar v ~ ℝ)
=> LtdErrorShow (LinearMap ℝ v ℝ) where
showsPrecShade'_errorLtdC :: Int -> Shade' (LinearMap ℝ v ℝ) -> ShowS
showsPrecShade'_errorLtdC Int
p Shade' (LinearMap ℝ v ℝ)
sh = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
7) (ShowS -> ShowS) -> ShowS -> ShowS
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
(String
"().<"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. Int -> Shade' v -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
7
((LinearMap ℝ v ℝ +> v) -> Shade' (LinearMap ℝ v ℝ) -> Shade' v
forall (shade :: * -> *) x y.
(IsShade shade, SimpleSpace x, SimpleSpace y, Scalar x ~ Scalar y,
Num' (Scalar x)) =>
(x +> y) -> shade x -> shade y
linIsoTransformShade (LinearFunction (Scalar v) (LinearMap ℝ v ℝ) v
-> LinearMap ℝ (LinearMap ℝ v ℝ) v
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
Object a c) =>
k b c -> a b c
arr LinearFunction (Scalar v) (LinearMap ℝ v ℝ) v
forall v. LinearSpace v => (v +> Scalar v) -+> DualVector v
fromLinearForm) Shade' (LinearMap ℝ v ℝ)
sh :: Shade' v)
instance ∀ v .
(HilbertSpace v, SemiInner v, FiniteDimensional v, LtdErrorShow v, Scalar v ~ ℝ)
=> LtdErrorShow (LinearMap ℝ v (ℝ,ℝ)) where
showsPrecShade'_errorLtdC :: Int -> Shade' (LinearMap ℝ v (ℝ, ℝ)) -> ShowS
showsPrecShade'_errorLtdC Int
p Shade' (LinearMap ℝ v (ℝ, ℝ))
sh = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
7) (ShowS -> ShowS) -> ShowS -> ShowS
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
( String
"Left ().<"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. Int -> Shade' v -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
7 Shade' v
shx
ShowS -> ShowS -> ShowS
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
. (String
"^+^Right().<"String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
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
. Int -> Shade' v -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
showsPrecShade'_errorLtdC Int
7 Shade' v
shy
where (Shade' v
shx,Shade' v
shy) = Shade' (v, v) -> (Shade' v, Shade' v)
forall (shade :: * -> *) x y.
(IsShade shade, PseudoAffine x, SimpleSpace (Needle x),
PseudoAffine y, SimpleSpace (Needle y),
Scalar (Needle x) ~ Scalar (Needle y)) =>
shade (x, y) -> (shade x, shade y)
factoriseShade
((LinearMap ℝ v (ℝ, ℝ) +> (v, v))
-> Shade' (LinearMap ℝ v (ℝ, ℝ)) -> Shade' (v, v)
forall (shade :: * -> *) x y.
(IsShade shade, SimpleSpace x, SimpleSpace y, Scalar x ~ Scalar y,
Num' (Scalar x)) =>
(x +> y) -> shade x -> shade y
linIsoTransformShade ((LinearMap (Scalar v) v (ℝ, ℝ) -> (v, v))
-> LinearMap ℝ (LinearMap (Scalar v) v (ℝ, ℝ)) (v, v)
forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun ((LinearMap (Scalar v) v (ℝ, ℝ) -> (v, v))
-> LinearMap ℝ (LinearMap (Scalar v) v (ℝ, ℝ)) (v, v))
-> (LinearMap (Scalar v) v (ℝ, ℝ) -> (v, v))
-> LinearMap ℝ (LinearMap (Scalar v) v (ℝ, ℝ)) (v, v)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \LinearMap (Scalar v) v (ℝ, ℝ)
f
-> ( LinearFunction (Scalar v) (LinearMap (Scalar v) v ℝ) v
forall v. LinearSpace v => (v +> Scalar v) -+> DualVector v
fromLinearForm LinearFunction (Scalar v) (LinearMap (Scalar v) v ℝ) v
-> LinearMap (Scalar v) v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar v) (ℝ, ℝ) ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst LinearMap (Scalar v) (ℝ, ℝ) ℝ
-> LinearMap (Scalar v) v (ℝ, ℝ) -> LinearMap (Scalar v) v ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearMap (Scalar v) v (ℝ, ℝ)
f
, LinearFunction (Scalar v) (LinearMap (Scalar v) v ℝ) v
forall v. LinearSpace v => (v +> Scalar v) -+> DualVector v
fromLinearForm LinearFunction (Scalar v) (LinearMap (Scalar v) v ℝ) v
-> LinearMap (Scalar v) v ℝ -> v
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearMap (Scalar v) (ℝ, ℝ) ℝ
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd LinearMap (Scalar v) (ℝ, ℝ) ℝ
-> LinearMap (Scalar v) v (ℝ, ℝ) -> LinearMap (Scalar v) v ℝ
forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. LinearMap (Scalar v) v (ℝ, ℝ)
f ) ) Shade' (LinearMap ℝ v (ℝ, ℝ))
sh
:: Shade' (v,v))
instance LtdErrorShow x => Show (Shade' x) where
showsPrec :: Int -> Shade' x -> ShowS
showsPrec = Int -> Shade' x -> ShowS
forall m. LtdErrorShow m => Int -> Shade' m -> ShowS
prettyShowsPrecShade'