{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LiberalTypeSynonyms #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnicodeSyntax #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
module Data.Manifold.PseudoAffine (
Manifold
, Semimanifold(..), Needle'
, PseudoAffine(..)
, LinearManifold, ScalarManifold
, Num', RealFrac', RealFloat'
, Num'', RealFrac'', RealFloat''
, Local(..)
#if !MIN_VERSION_manifolds_core(0,6,0)
, (!+~^)
#endif
, Metric, Metric'
, RieMetric, RieMetric'
, SemimanifoldWitness(..)
, PseudoAffineWitness(..)
, DualNeedleWitness
, WithField
, LocallyScalable
, LocalLinear, LocalBilinear, LocalAffine
, alerpB, palerp, palerpB, LocallyCoercible(..), CanonicalDiffeomorphism(..)
, ImpliesMetric(..), coerceMetric, coerceMetric'
, Connected (..)
) where
import Math.Manifold.Core.PseudoAffine
import Data.Manifold.WithBoundary.Class
import Data.Maybe
import Data.Fixed
import Data.VectorSpace
import Linear.V0
import Linear.V1
import Linear.V2
import Linear.V3
import Linear.V4
import qualified Linear.Affine as LinAff
import Data.Embedding
import Data.LinearMap
import Data.VectorSpace.Free
import Math.LinearMap.Category
import Data.AffineSpace
import Data.Tagged
import Data.Manifold.Types.Primitive
import qualified Prelude as Hask
import qualified Control.Applicative as Hask
import Control.Category.Constrained.Prelude hiding ((^))
import Control.Arrow.Constrained
import Control.Monad.Constrained
import Data.Foldable.Constrained
import Control.Lens (Lens', lens, (^.), (&), (%~), (.~))
import Data.CallStack (HasCallStack)
import GHC.Exts (Constraint)
class (OpenManifold m, ProjectableBoundary m, LSpace (Needle m))
=> Manifold m where
instance (OpenManifold m, ProjectableBoundary m, LSpace (Needle m))
=> Manifold m
class ( Semimanifold x, Semimanifold ξ, LSpace (Needle x), LSpace (Needle ξ)
, Scalar (Needle x) ~ Scalar (Needle ξ) )
=> LocallyCoercible x ξ where
locallyTrivialDiffeomorphism :: x -> ξ
coerceNeedle :: Hask.Functor p => p (x,ξ) -> (Needle x -+> Needle ξ)
coerceNeedle' :: Hask.Functor p => p (x,ξ) -> (Needle' x -+> Needle' ξ)
coerceNorm :: Hask.Functor p => p (x,ξ) -> Metric x -> Metric ξ
coerceNorm p (x, ξ)
p = case ( forall x ξ. LocallyCoercible x ξ => CanonicalDiffeomorphism ξ x
oppositeLocalCoercion :: CanonicalDiffeomorphism ξ x
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle ξ) ) of
(CanonicalDiffeomorphism ξ x
CanonicalDiffeomorphism, DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle ξ)
DualSpaceWitness)
-> case ( forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle x -+> Needle ξ
coerceNeedle (forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swapforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>p (x, ξ)
p), forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> DualVector (Needle x) -+> DualVector (Needle ξ)
coerceNeedle' p (x, ξ)
p ) of
(LinearFunction (Scalar (Needle ξ)) (Needle ξ) (Needle x)
f, LinearFunction
(Scalar (Needle ξ)) (DualVector (Needle x)) (DualVector (Needle ξ))
f') -> \(Norm Needle x -+> DualVector (Needle x)
n) -> forall v. (v -+> DualVector v) -> Norm v
Norm forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction
(Scalar (Needle ξ)) (DualVector (Needle x)) (DualVector (Needle ξ))
f' forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. Needle x -+> DualVector (Needle x)
n 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 ξ)) (Needle ξ) (Needle x)
f
coerceVariance :: Hask.Functor p => p (x,ξ) -> Metric' x -> Metric' ξ
coerceVariance p (x, ξ)
p = case ( forall x ξ. LocallyCoercible x ξ => CanonicalDiffeomorphism ξ x
oppositeLocalCoercion :: CanonicalDiffeomorphism ξ x
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle x)
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness (Needle ξ) ) of
(CanonicalDiffeomorphism ξ x
CanonicalDiffeomorphism, DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle ξ)
DualSpaceWitness)
-> case ( forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle x -+> Needle ξ
coerceNeedle p (x, ξ)
p, forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> DualVector (Needle x) -+> DualVector (Needle ξ)
coerceNeedle' (forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swapforall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>p (x, ξ)
p) ) of
(Needle x -+> Needle ξ
f, LinearFunction
(Scalar (Needle ξ)) (DualVector (Needle ξ)) (DualVector (Needle x))
f') -> \(Norm DualVector (Needle x) -+> DualVector (DualVector (Needle x))
n) -> forall v. (v -+> DualVector v) -> Norm v
Norm forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x -+> Needle ξ
f forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. DualVector (Needle x) -+> DualVector (DualVector (Needle x))
n 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 ξ)) (DualVector (Needle ξ)) (DualVector (Needle x))
f'
oppositeLocalCoercion :: CanonicalDiffeomorphism ξ x
default oppositeLocalCoercion :: LocallyCoercible ξ x => CanonicalDiffeomorphism ξ x
oppositeLocalCoercion = forall a b. LocallyCoercible a b => CanonicalDiffeomorphism a b
CanonicalDiffeomorphism
type NumPrime n = (Num' n, Eq n)
#define identityCoercion(c,t) \
instance (c) => LocallyCoercible (t) (t) where { \
locallyTrivialDiffeomorphism = id; \
coerceNeedle _ = id; \
coerceNeedle' _ = id; \
oppositeLocalCoercion = CanonicalDiffeomorphism }
identityCoercion(NumPrime s, ZeroDim s)
identityCoercion(NumPrime s, V0 s)
identityCoercion((), ℝ)
identityCoercion(NumPrime s, V1 s)
identityCoercion((), (ℝ,ℝ))
identityCoercion(NumPrime s, V2 s)
identityCoercion((), (ℝ,(ℝ,ℝ)))
identityCoercion((), ((ℝ,ℝ),ℝ))
identityCoercion(NumPrime s, V3 s)
identityCoercion(NumPrime s, V4 s)
data CanonicalDiffeomorphism a b where
CanonicalDiffeomorphism :: LocallyCoercible a b => CanonicalDiffeomorphism a b
newtype Local x = Local { forall x. Local x -> Needle x
getLocalOffset :: Needle x }
deriving instance (Show (Needle x)) => Show (Local x)
type LocallyScalable s x = ( PseudoAffine x
, LSpace (Needle x)
, s ~ Scalar (Needle x)
, s ~ Scalar (Needle' x)
, Num' s )
type LocalLinear x y = LinearMap (Scalar (Needle x)) (Needle x) (Needle y)
type LocalBilinear x y = LinearMap (Scalar (Needle x))
(SymmetricTensor (Scalar (Needle x)) (Needle x))
(Needle y)
type LocalAffine x y = (Needle y, LocalLinear x y)
type WithField s c x = ( c x, s ~ Scalar (Needle x), s ~ Scalar (Needle' x) )
type Needle' x = DualVector (Needle x)
type Metric x = Norm (Needle x)
type Metric' x = Variance (Needle x)
type RieMetric x = x -> Metric x
type RieMetric' x = x -> Metric' x
coerceMetric :: ∀ x ξ . (LocallyCoercible x ξ, LSpace (Needle ξ))
=> RieMetric ξ -> RieMetric x
coerceMetric :: forall x ξ.
(LocallyCoercible x ξ, LSpace (Needle ξ)) =>
RieMetric ξ -> RieMetric x
coerceMetric = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness ξ ) of
(DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle ξ)
DualSpaceWitness)
-> \RieMetric ξ
m x
x -> case RieMetric ξ
m forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x ξ. LocallyCoercible x ξ => x -> ξ
locallyTrivialDiffeomorphism x
x of
Norm Needle ξ -+> DualVector (Needle ξ)
sc -> forall v. (v -+> DualVector v) -> Norm v
Norm forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction
(Scalar (DualVector (Needle x)))
(DualVector (Needle ξ))
(DualVector (Needle x))
bw 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 ξ -+> DualVector (Needle ξ)
sc 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 ξ
fw
where fw :: Needle x -+> Needle ξ
fw = forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle x -+> Needle ξ
coerceNeedle ([]::[(x,ξ)])
bw :: LinearFunction
(Scalar (DualVector (Needle x)))
(DualVector (Needle ξ))
(DualVector (Needle x))
bw = case forall x ξ. LocallyCoercible x ξ => CanonicalDiffeomorphism ξ x
oppositeLocalCoercion :: CanonicalDiffeomorphism ξ x of
CanonicalDiffeomorphism ξ x
CanonicalDiffeomorphism -> forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> DualVector (Needle x) -+> DualVector (Needle ξ)
coerceNeedle' ([]::[(ξ,x)])
coerceMetric' :: ∀ x ξ . (LocallyCoercible x ξ, LSpace (Needle ξ))
=> RieMetric' ξ -> RieMetric' x
coerceMetric' :: forall x ξ.
(LocallyCoercible x ξ, LSpace (Needle ξ)) =>
RieMetric' ξ -> RieMetric' x
coerceMetric' = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness x
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualNeedleWitness ξ ) of
(DualSpaceWitness (Needle x)
DualSpaceWitness, DualSpaceWitness (Needle ξ)
DualSpaceWitness)
-> \RieMetric' ξ
m x
x -> case RieMetric' ξ
m forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall x ξ. LocallyCoercible x ξ => x -> ξ
locallyTrivialDiffeomorphism x
x of
Norm DualVector (Needle ξ) -+> DualVector (DualVector (Needle ξ))
sc -> forall v. (v -+> DualVector v) -> Norm v
Norm forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ LinearFunction (Scalar (Needle ξ)) (Needle ξ) (Needle x)
bw 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
. DualVector (Needle ξ) -+> DualVector (DualVector (Needle ξ))
sc 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
. DualVector (Needle x) -+> DualVector (Needle ξ)
fw
where fw :: DualVector (Needle x) -+> DualVector (Needle ξ)
fw = forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> DualVector (Needle x) -+> DualVector (Needle ξ)
coerceNeedle' ([]::[(x,ξ)])
bw :: LinearFunction (Scalar (Needle ξ)) (Needle ξ) (Needle x)
bw = case forall x ξ. LocallyCoercible x ξ => CanonicalDiffeomorphism ξ x
oppositeLocalCoercion :: CanonicalDiffeomorphism ξ x of
CanonicalDiffeomorphism ξ x
CanonicalDiffeomorphism -> forall x ξ (p :: * -> *).
(LocallyCoercible x ξ, Functor p) =>
p (x, ξ) -> Needle x -+> Needle ξ
coerceNeedle ([]::[(ξ,x)])
hugeℝVal :: ℝ
hugeℝVal :: ℝ
hugeℝVal = ℝ
1e+100
#define deriveAffine(c,t) \
instance (c) => Semimanifold (t) where { \
type Needle (t) = Diff (t); \
fromInterior = id; \
toInterior = pure; \
translateP = Tagged (.+^); \
(.+~^) = (.+^) }; \
instance (c) => PseudoAffine (t) where { \
a.-~.b = pure (a.-.b); }
instance (NumPrime s) => LocallyCoercible (ZeroDim s) (V0 s) where
locallyTrivialDiffeomorphism :: ZeroDim s -> V0 s
locallyTrivialDiffeomorphism ZeroDim s
Origin = forall a. V0 a
V0
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (ZeroDim s, V0 s) -> Needle (ZeroDim s) -+> Needle (V0 s)
coerceNeedle p (ZeroDim s, V0 s)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ZeroDim s
Origin -> forall a. V0 a
V0
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (ZeroDim s, V0 s) -> Needle' (ZeroDim s) -+> Needle' (V0 s)
coerceNeedle' p (ZeroDim s, V0 s)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ZeroDim s
Origin -> forall a. V0 a
V0
instance (NumPrime s) => LocallyCoercible (V0 s) (ZeroDim s) where
locallyTrivialDiffeomorphism :: V0 s -> ZeroDim s
locallyTrivialDiffeomorphism V0 s
V0 = forall s. ZeroDim s
Origin
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (V0 s, ZeroDim s) -> Needle (V0 s) -+> Needle (ZeroDim s)
coerceNeedle p (V0 s, ZeroDim s)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \V0 s
V0 -> forall s. ZeroDim s
Origin
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (V0 s, ZeroDim s) -> Needle' (V0 s) -+> Needle' (ZeroDim s)
coerceNeedle' p (V0 s, ZeroDim s)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \V0 s
V0 -> forall s. ZeroDim s
Origin
instance LocallyCoercible ℝ (V1 ℝ) where
locallyTrivialDiffeomorphism :: ℝ -> ℝ¹
locallyTrivialDiffeomorphism = forall a. a -> V1 a
V1
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (ℝ, ℝ¹) -> Needle ℝ -+> Needle ℝ¹
coerceNeedle p (ℝ, ℝ¹)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall a. a -> V1 a
V1
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (ℝ, ℝ¹) -> Needle' ℝ -+> Needle' ℝ¹
coerceNeedle' p (ℝ, ℝ¹)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall a. a -> V1 a
V1
instance LocallyCoercible (V1 ℝ) ℝ where
locallyTrivialDiffeomorphism :: ℝ¹ -> ℝ
locallyTrivialDiffeomorphism (V1 ℝ
n) = ℝ
n
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (ℝ¹, ℝ) -> Needle ℝ¹ -+> Needle ℝ
coerceNeedle p (ℝ¹, ℝ)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V1 ℝ
n) -> ℝ
n
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (ℝ¹, ℝ) -> Needle' ℝ¹ -+> Needle' ℝ
coerceNeedle' p (ℝ¹, ℝ)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V1 ℝ
n) -> ℝ
n
instance LocallyCoercible (ℝ,ℝ) (V2 ℝ) where
locallyTrivialDiffeomorphism :: (ℝ, ℝ) -> ℝ²
locallyTrivialDiffeomorphism = forall (k :: * -> * -> *) a b c.
(Curry k, ObjectPair k a b, ObjectMorphism k b c) =>
k a (k b c) -> k (a, b) c
uncurry forall a. a -> a -> V2 a
V2
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p ((ℝ, ℝ), ℝ²) -> Needle (ℝ, ℝ) -+> Needle ℝ²
coerceNeedle p ((ℝ, ℝ), ℝ²)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (k :: * -> * -> *) a b c.
(Curry k, ObjectPair k a b, ObjectMorphism k b c) =>
k a (k b c) -> k (a, b) c
uncurry forall a. a -> a -> V2 a
V2
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p ((ℝ, ℝ), ℝ²) -> Needle' (ℝ, ℝ) -+> Needle' ℝ²
coerceNeedle' p ((ℝ, ℝ), ℝ²)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall (k :: * -> * -> *) a b c.
(Curry k, ObjectPair k a b, ObjectMorphism k b c) =>
k a (k b c) -> k (a, b) c
uncurry forall a. a -> a -> V2 a
V2
instance LocallyCoercible (V2 ℝ) (ℝ,ℝ) where
locallyTrivialDiffeomorphism :: ℝ² -> (ℝ, ℝ)
locallyTrivialDiffeomorphism (V2 ℝ
x ℝ
y) = (ℝ
x,ℝ
y)
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (ℝ², (ℝ, ℝ)) -> Needle ℝ² -+> Needle (ℝ, ℝ)
coerceNeedle p (ℝ², (ℝ, ℝ))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V2 ℝ
x ℝ
y) -> (ℝ
x,ℝ
y)
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (ℝ², (ℝ, ℝ)) -> Needle' ℝ² -+> Needle' (ℝ, ℝ)
coerceNeedle' p (ℝ², (ℝ, ℝ))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V2 ℝ
x ℝ
y) -> (ℝ
x,ℝ
y)
instance LocallyCoercible ((ℝ,ℝ),ℝ) (V3 ℝ) where
locallyTrivialDiffeomorphism :: ((ℝ, ℝ), ℝ) -> ℝ³
locallyTrivialDiffeomorphism ((ℝ
x,ℝ
y),ℝ
z) = forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (((ℝ, ℝ), ℝ), ℝ³) -> Needle ((ℝ, ℝ), ℝ) -+> Needle ℝ³
coerceNeedle p (((ℝ, ℝ), ℝ), ℝ³)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \((ℝ
x,ℝ
y),ℝ
z) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (((ℝ, ℝ), ℝ), ℝ³) -> Needle' ((ℝ, ℝ), ℝ) -+> Needle' ℝ³
coerceNeedle' p (((ℝ, ℝ), ℝ), ℝ³)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \((ℝ
x,ℝ
y),ℝ
z) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
instance LocallyCoercible (ℝ,(ℝ,ℝ)) (V3 ℝ) where
locallyTrivialDiffeomorphism :: (ℝ, (ℝ, ℝ)) -> ℝ³
locallyTrivialDiffeomorphism (ℝ
x,(ℝ
y,ℝ
z)) = forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p ((ℝ, (ℝ, ℝ)), ℝ³) -> Needle (ℝ, (ℝ, ℝ)) -+> Needle ℝ³
coerceNeedle p ((ℝ, (ℝ, ℝ)), ℝ³)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(ℝ
x,(ℝ
y,ℝ
z)) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p ((ℝ, (ℝ, ℝ)), ℝ³) -> Needle' (ℝ, (ℝ, ℝ)) -+> Needle' ℝ³
coerceNeedle' p ((ℝ, (ℝ, ℝ)), ℝ³)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(ℝ
x,(ℝ
y,ℝ
z)) -> forall a. a -> a -> a -> V3 a
V3 ℝ
x ℝ
y ℝ
z
instance LocallyCoercible (V3 ℝ) ((ℝ,ℝ),ℝ) where
locallyTrivialDiffeomorphism :: ℝ³ -> ((ℝ, ℝ), ℝ)
locallyTrivialDiffeomorphism (V3 ℝ
x ℝ
y ℝ
z) = ((ℝ
x,ℝ
y),ℝ
z)
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (ℝ³, ((ℝ, ℝ), ℝ)) -> Needle ℝ³ -+> Needle ((ℝ, ℝ), ℝ)
coerceNeedle p (ℝ³, ((ℝ, ℝ), ℝ))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V3 ℝ
x ℝ
y ℝ
z) -> ((ℝ
x,ℝ
y),ℝ
z)
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (ℝ³, ((ℝ, ℝ), ℝ)) -> Needle' ℝ³ -+> Needle' ((ℝ, ℝ), ℝ)
coerceNeedle' p (ℝ³, ((ℝ, ℝ), ℝ))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V3 ℝ
x ℝ
y ℝ
z) -> ((ℝ
x,ℝ
y),ℝ
z)
instance LocallyCoercible (V3 ℝ) (ℝ,(ℝ,ℝ)) where
locallyTrivialDiffeomorphism :: ℝ³ -> (ℝ, (ℝ, ℝ))
locallyTrivialDiffeomorphism (V3 ℝ
x ℝ
y ℝ
z) = (ℝ
x,(ℝ
y,ℝ
z))
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (ℝ³, (ℝ, (ℝ, ℝ))) -> Needle ℝ³ -+> Needle (ℝ, (ℝ, ℝ))
coerceNeedle p (ℝ³, (ℝ, (ℝ, ℝ)))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V3 ℝ
x ℝ
y ℝ
z) -> (ℝ
x,(ℝ
y,ℝ
z))
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (ℝ³, (ℝ, (ℝ, ℝ))) -> Needle' ℝ³ -+> Needle' (ℝ, (ℝ, ℝ))
coerceNeedle' p (ℝ³, (ℝ, (ℝ, ℝ)))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V3 ℝ
x ℝ
y ℝ
z) -> (ℝ
x,(ℝ
y,ℝ
z))
instance LocallyCoercible ((ℝ,ℝ),(ℝ,ℝ)) (V4 ℝ) where
locallyTrivialDiffeomorphism :: ((ℝ, ℝ), (ℝ, ℝ)) -> ℝ⁴
locallyTrivialDiffeomorphism ((ℝ
x,ℝ
y),(ℝ
z,ℝ
w)) = forall a. a -> a -> a -> a -> V4 a
V4 ℝ
x ℝ
y ℝ
z ℝ
w
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (((ℝ, ℝ), (ℝ, ℝ)), ℝ⁴) -> Needle ((ℝ, ℝ), (ℝ, ℝ)) -+> Needle ℝ⁴
coerceNeedle p (((ℝ, ℝ), (ℝ, ℝ)), ℝ⁴)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \((ℝ
x,ℝ
y),(ℝ
z,ℝ
w)) -> forall a. a -> a -> a -> a -> V4 a
V4 ℝ
x ℝ
y ℝ
z ℝ
w
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (((ℝ, ℝ), (ℝ, ℝ)), ℝ⁴) -> Needle' ((ℝ, ℝ), (ℝ, ℝ)) -+> Needle' ℝ⁴
coerceNeedle' p (((ℝ, ℝ), (ℝ, ℝ)), ℝ⁴)
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \((ℝ
x,ℝ
y),(ℝ
z,ℝ
w)) -> forall a. a -> a -> a -> a -> V4 a
V4 ℝ
x ℝ
y ℝ
z ℝ
w
instance LocallyCoercible (V4 ℝ) ((ℝ,ℝ),(ℝ,ℝ)) where
locallyTrivialDiffeomorphism :: ℝ⁴ -> ((ℝ, ℝ), (ℝ, ℝ))
locallyTrivialDiffeomorphism (V4 ℝ
x ℝ
y ℝ
z ℝ
w) = ((ℝ
x,ℝ
y),(ℝ
z,ℝ
w))
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (ℝ⁴, ((ℝ, ℝ), (ℝ, ℝ))) -> Needle ℝ⁴ -+> Needle ((ℝ, ℝ), (ℝ, ℝ))
coerceNeedle p (ℝ⁴, ((ℝ, ℝ), (ℝ, ℝ)))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V4 ℝ
x ℝ
y ℝ
z ℝ
w) -> ((ℝ
x,ℝ
y),(ℝ
z,ℝ
w))
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (ℝ⁴, ((ℝ, ℝ), (ℝ, ℝ))) -> Needle' ℝ⁴ -+> Needle' ((ℝ, ℝ), (ℝ, ℝ))
coerceNeedle' p (ℝ⁴, ((ℝ, ℝ), (ℝ, ℝ)))
_ = forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(V4 ℝ
x ℝ
y ℝ
z ℝ
w) -> ((ℝ
x,ℝ
y),(ℝ
z,ℝ
w))
instance ∀ a b c .
( Semimanifold a, Semimanifold b, Semimanifold c
, LSpace (Needle a), LSpace (Needle b), LSpace (Needle c)
, Scalar (Needle a) ~ Scalar (Needle b), Scalar (Needle b) ~ Scalar (Needle c)
)
=> LocallyCoercible (a,(b,c)) ((a,b),c) where
locallyTrivialDiffeomorphism :: (a, (b, c)) -> ((a, b), c)
locallyTrivialDiffeomorphism = forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k (a, (b, c)) ((a, b), c)
regroup
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p ((a, (b, c)), ((a, b), c))
-> Needle (a, (b, c)) -+> Needle ((a, b), c)
coerceNeedle p ((a, (b, c)), ((a, b), c))
_ = forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k (a, (b, c)) ((a, b), c)
regroup
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p ((a, (b, c)), ((a, b), c))
-> Needle' (a, (b, c)) -+> Needle' ((a, b), c)
coerceNeedle' p ((a, (b, c)), ((a, b), c))
_ = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle a)
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle b)
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle c) ) of
(DualSpaceWitness (Needle a)
DualSpaceWitness, DualSpaceWitness (Needle b)
DualSpaceWitness, DualSpaceWitness (Needle c)
DualSpaceWitness) -> forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k (a, (b, c)) ((a, b), c)
regroup
oppositeLocalCoercion :: CanonicalDiffeomorphism ((a, b), c) (a, (b, c))
oppositeLocalCoercion = forall a b. LocallyCoercible a b => CanonicalDiffeomorphism a b
CanonicalDiffeomorphism
instance ∀ a b c .
( Semimanifold a, Semimanifold b, Semimanifold c
, LSpace (Needle a), LSpace (Needle b), LSpace (Needle c)
, Scalar (Needle a) ~ Scalar (Needle b), Scalar (Needle b) ~ Scalar (Needle c)
)
=> LocallyCoercible ((a,b),c) (a,(b,c)) where
locallyTrivialDiffeomorphism :: ((a, b), c) -> (a, (b, c))
locallyTrivialDiffeomorphism = forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup'
coerceNeedle :: forall (p :: * -> *).
Functor p =>
p (((a, b), c), (a, (b, c)))
-> Needle ((a, b), c) -+> Needle (a, (b, c))
coerceNeedle p (((a, b), c), (a, (b, c)))
_ = forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup'
coerceNeedle' :: forall (p :: * -> *).
Functor p =>
p (((a, b), c), (a, (b, c)))
-> Needle' ((a, b), c) -+> Needle' (a, (b, c))
coerceNeedle' p (((a, b), c), (a, (b, c)))
_ = case ( forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle a)
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle b)
, forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness @(Needle c) ) of
(DualSpaceWitness (Needle a)
DualSpaceWitness, DualSpaceWitness (Needle b)
DualSpaceWitness, DualSpaceWitness (Needle c)
DualSpaceWitness) -> forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup'
oppositeLocalCoercion :: CanonicalDiffeomorphism (a, (b, c)) ((a, b), c)
oppositeLocalCoercion = forall a b. LocallyCoercible a b => CanonicalDiffeomorphism a b
CanonicalDiffeomorphism
instance (LinearSpace (a n), Needle (a n) ~ a n)
=> Semimanifold (LinAff.Point a n) where
type Needle (LinAff.Point a n) = a n
LinAff.P a n
v .+~^ :: Point a n -> Needle (Point a n) -> Point a n
.+~^ Needle (Point a n)
w = forall (f :: * -> *) a. f a -> Point f a
LinAff.P forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ a n
v forall v. AdditiveGroup v => v -> v -> v
^+^ Needle (Point a n)
w
instance (LinearSpace (a n), Needle (a n) ~ a n)
=> PseudoAffine (LinAff.Point a n) where
LinAff.P a n
v .-~. :: Point a n -> Point a n -> Maybe (Needle (Point a n))
.-~. LinAff.P a n
w = forall (m :: * -> *) a. Monad m (->) => a -> m a
return forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ a n
v forall v. AdditiveGroup v => v -> v -> v
^-^ a n
w
LinAff.P a n
v .-~! :: HasCallStack => Point a n -> Point a n -> Needle (Point a n)
.-~! LinAff.P a n
w = a n
v forall v. AdditiveGroup v => v -> v -> v
^-^ a n
w
instance RealFloat' r => Semimanifold (S⁰_ r) where
type Needle (S⁰_ r) = ZeroDim r
S⁰_ r
p .+~^ :: S⁰_ r -> Needle (S⁰_ r) -> S⁰_ r
.+~^ ZeroDim r
Needle (S⁰_ r)
Origin = S⁰_ r
p
S⁰_ r
p .-~^ :: S⁰_ r -> Needle (S⁰_ r) -> S⁰_ r
.-~^ ZeroDim r
Needle (S⁰_ r)
Origin = S⁰_ r
p
instance RealFloat' r => PseudoAffine (S⁰_ r) where
S⁰_ r
PositiveHalfSphere .-~. :: S⁰_ r -> S⁰_ r -> Maybe (Needle (S⁰_ r))
.-~. S⁰_ r
PositiveHalfSphere = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall s. ZeroDim s
Origin
S⁰_ r
NegativeHalfSphere .-~. S⁰_ r
NegativeHalfSphere = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall s. ZeroDim s
Origin
S⁰_ r
_ .-~. S⁰_ r
_ = forall a. Maybe a
Nothing
S⁰_ r
PositiveHalfSphere .-~! :: HasCallStack => S⁰_ r -> S⁰_ r -> Needle (S⁰_ r)
.-~! S⁰_ r
PositiveHalfSphere = forall s. ZeroDim s
Origin
S⁰_ r
NegativeHalfSphere .-~! S⁰_ r
NegativeHalfSphere = forall s. ZeroDim s
Origin
S⁰_ r
_ .-~! S⁰_ r
_ = forall a. HasCallStack => String -> a
error String
"There is no path between the two 0-dimensional half spheres."
instance RealFloat' r => Semimanifold (S¹_ r) where
type Needle (S¹_ r) = r
S¹Polar r
φ₀ .+~^ :: S¹_ r -> Needle (S¹_ r) -> S¹_ r
.+~^ Needle (S¹_ r)
δφ = forall r. r -> S¹_ r
S¹Polar forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ r
φ'
where φ' :: r
φ' = forall r. RealFloat r => r -> r
toS¹range forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ r
φ₀ forall a. Num a => a -> a -> a
+ Needle (S¹_ r)
δφ
semimanifoldWitness :: SemimanifoldWitness (S¹_ r)
semimanifoldWitness = case forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @r of
LinearManifoldWitness r
LinearManifoldWitness -> forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness
instance RealFloat' r => PseudoAffine (S¹_ r) where
S¹_ r
p .-~. :: S¹_ r -> S¹_ r -> Maybe (Needle (S¹_ r))
.-~. S¹_ r
q = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (S¹_ r
pforall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!S¹_ r
q)
S¹Polar r
φ₁ .-~! :: HasCallStack => S¹_ r -> S¹_ r -> Needle (S¹_ r)
.-~! S¹Polar r
φ₀
| r
δφ forall a. Ord a => a -> a -> Bool
> forall a. Floating a => a
pi = r
δφ forall a. Num a => a -> a -> a
- forall r. RealFloat r => r
tau
| r
δφ forall a. Ord a => a -> a -> Bool
< (-forall a. Floating a => a
pi) = r
δφ forall a. Num a => a -> a -> a
+ forall r. RealFloat r => r
tau
| Bool
otherwise = r
δφ
where δφ :: r
δφ = r
φ₁ forall a. Num a => a -> a -> a
- r
φ₀
instance RealFloat' s => Semimanifold (S²_ s) where
type Needle (S²_ s) = V2 s
.+~^ :: S²_ s -> Needle (S²_ s) -> S²_ s
(.+~^) = case forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness @s of
LinearManifoldWitness s
LinearManifoldWitness ->
let addS² :: S²_ (Scalar v) -> v -> S²_ (Scalar v)
addS² (S²Polar Scalar v
θ₀ Scalar v
φ₀) v
𝐯 = forall r. r -> r -> S²_ r
S²Polar Scalar v
θ₁ Scalar v
φ₁
where
S¹Polar Scalar v
γc = forall m v. NaturallyEmbedded m v => v -> m
coEmbed v
𝐯
γ :: Scalar v
γ | Scalar v
θ₀ forall a. Ord a => a -> a -> Bool
< forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Scalar v
2 = Scalar v
γc forall a. Num a => a -> a -> a
- Scalar v
φ₀
| Bool
otherwise = Scalar v
γc forall a. Num a => a -> a -> a
+ Scalar v
φ₀
d :: Scalar v
d = forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> s
magnitude v
𝐯
S¹Polar Scalar v
φ₁ = forall r. r -> S¹_ r
S¹Polar Scalar v
φ₀ forall x. Semimanifold x => x -> Needle x -> x
.+~^ Scalar v
δφ
V3 Scalar v
bx Scalar v
by Scalar v
bz = forall m v. NaturallyEmbedded m v => m -> v
embed forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall r. r -> r -> S²_ r
S²Polar Scalar v
d Scalar v
γ
sθ₀ :: Scalar v
sθ₀ = forall a. Floating a => a -> a
sin Scalar v
θ₀; cθ₀ :: Scalar v
cθ₀ = forall a. Floating a => a -> a
cos Scalar v
θ₀
(Scalar v
qx,Scalar v
qz) = ( Scalar v
cθ₀ forall a. Num a => a -> a -> a
* Scalar v
bx forall a. Num a => a -> a -> a
+ Scalar v
sθ₀ forall a. Num a => a -> a -> a
* Scalar v
bz
,-Scalar v
sθ₀ forall a. Num a => a -> a -> a
* Scalar v
bx forall a. Num a => a -> a -> a
+ Scalar v
cθ₀ forall a. Num a => a -> a -> a
* Scalar v
bz )
qy :: Scalar v
qy = Scalar v
by
S²Polar Scalar v
θ₁ Scalar v
δφ = forall m v. NaturallyEmbedded m v => v -> m
coEmbed forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. a -> a -> a -> V3 a
V3 Scalar v
qx Scalar v
qy Scalar v
qz
in forall {v}.
(NaturallyEmbedded (S¹_ (Scalar v)) v, Num' (Scalar v),
IEEE (Scalar v), InnerSpace v, InnerSpace (Scalar v)) =>
S²_ (Scalar v) -> v -> S²_ (Scalar v)
addS²
instance RealFloat' s => PseudoAffine (S²_ s) where
S²_ s
p.-~. :: S²_ s -> S²_ s -> Maybe (Needle (S²_ s))
.-~.S²_ s
q = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (S²_ s
pforall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!S²_ s
q)
S²Polar s
θ₁ s
φ₁ .-~! :: HasCallStack => S²_ s -> S²_ s -> Needle (S²_ s)
.-~! S²Polar s
θ₀ s
φ₀ = s
d forall v. VectorSpace v => Scalar v -> v -> v
*^ forall m v. NaturallyEmbedded m v => m -> v
embed(forall r. r -> S¹_ r
S¹Polar s
γc)
where
V3 s
qx s
qy s
qz = forall m v. NaturallyEmbedded m v => m -> v
embed forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall r. r -> r -> S²_ r
S²Polar s
θ₁ (s
φ₁forall a. Num a => a -> a -> a
-s
φ₀)
sθ₀ :: s
sθ₀ = forall a. Floating a => a -> a
sin s
θ₀; cθ₀ :: s
cθ₀ = forall a. Floating a => a -> a
cos s
θ₀
(s
bx,s
bz) = ( s
cθ₀ forall a. Num a => a -> a -> a
* s
qx forall a. Num a => a -> a -> a
- s
sθ₀ forall a. Num a => a -> a -> a
* s
qz
, s
sθ₀ forall a. Num a => a -> a -> a
* s
qx forall a. Num a => a -> a -> a
+ s
cθ₀ forall a. Num a => a -> a -> a
* s
qz )
by :: s
by = s
qy
S²Polar s
d s
γ = forall m v. NaturallyEmbedded m v => v -> m
coEmbed forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ forall a. a -> a -> a -> V3 a
V3 s
bx s
by s
bz
γc :: s
γc | s
θ₀ forall a. Ord a => a -> a -> Bool
< forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/s
2 = s
γ forall a. Num a => a -> a -> a
+ s
φ₀
| Bool
otherwise = s
γ forall a. Num a => a -> a -> a
- s
φ₀
instance Semimanifold ℝP² where
type Needle ℝP² = ℝ²
HemisphereℝP²Polar ℝ
θ₀ ℝ
φ₀ .+~^ :: ℝP² -> Needle ℝP² -> ℝP²
.+~^ Needle ℝP²
v
= case forall r. r -> r -> S²_ r
S²Polar ℝ
θ₀ ℝ
φ₀ forall x. Semimanifold x => x -> Needle x -> x
.+~^ Needle ℝP²
v of
S²Polar ℝ
θ₁ ℝ
φ₁
| ℝ
θ₁ forall a. Ord a => a -> a -> Bool
> forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/ℝ
2 -> forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar (forall a. Floating a => a
piforall a. Num a => a -> a -> a
-ℝ
θ₁) (-ℝ
φ₁)
| Bool
otherwise -> forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar ℝ
θ₁ ℝ
φ₁
instance PseudoAffine ℝP² where
ℝP²
p.-~. :: ℝP² -> ℝP² -> Maybe (Needle ℝP²)
.-~.ℝP²
q = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (ℝP²
pforall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!ℝP²
q)
HemisphereℝP²Polar ℝ
θ₁ ℝ
φ₁ .-~! :: HasCallStack => ℝP² -> ℝP² -> Needle ℝP²
.-~! HemisphereℝP²Polar ℝ
θ₀ ℝ
φ₀
= case forall r. r -> r -> S²_ r
S²Polar ℝ
θ₁ ℝ
φ₁ forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! forall r. r -> r -> S²_ r
S²Polar ℝ
θ₀ ℝ
φ₀ of
Needle S²
v -> let r² :: Scalar ℝ²
r² = forall v s. (InnerSpace v, s ~ Scalar v) => v -> s
magnitudeSq Needle S²
v
in if Scalar ℝ²
r²forall a. Ord a => a -> a -> Bool
>forall a. Floating a => a
piforall a. Num a => a -> Int -> a
^Int
2forall a. Fractional a => a -> a -> a
/Scalar ℝ²
4
then forall r. r -> r -> S²_ r
S²Polar (forall a. Floating a => a
piforall a. Num a => a -> a -> a
-ℝ
θ₁) (-ℝ
φ₁) forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~! forall r. r -> r -> S²_ r
S²Polar ℝ
θ₀ ℝ
φ₀
else Needle S²
v
class ImpliesMetric s where
type MetricRequirement s x :: Constraint
type MetricRequirement s x = Semimanifold x
inferMetric :: (MetricRequirement s x, LSpace (Needle x))
=> s x -> Metric x
inferMetric' :: (MetricRequirement s x, LSpace (Needle x))
=> s x -> Metric' x
instance ImpliesMetric Norm where
type MetricRequirement Norm x = (SimpleSpace x, x ~ Needle x)
inferMetric :: forall x.
(MetricRequirement Norm x, LSpace (Needle x)) =>
Norm x -> Metric x
inferMetric = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
inferMetric' :: forall x.
(MetricRequirement Norm x, LSpace (Needle x)) =>
Norm x -> Metric' x
inferMetric' = forall v. SimpleSpace v => Norm v -> Variance v
dualNorm
type DualNeedleWitness x = DualSpaceWitness (Needle x)
#if !MIN_VERSION_manifolds_core(0,6,0)
infixl 6 !+~^
(!+~^) :: ∀ x . (Semimanifold x, HasCallStack) => x -> Needle x -> x
p!+~^v = case toInterior p of
Just p' -> p'.+~^v
#endif
infix 6 .−.
class (PseudoAffine m) => Connected m where
{-# MINIMAL #-}
(.−.) :: m -> m -> Needle m
(.−.) = forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
(.-~!)
instance Connected ℝ⁰
instance Connected ℝ
instance Connected ℝ¹
instance Connected ℝ²
instance Connected ℝ³
instance Connected ℝ⁴
instance Connected S¹
instance Connected S²
instance Connected ℝP⁰
instance Connected ℝP¹
instance Connected ℝP²
instance (Connected x, Connected y) => Connected (x,y)
instance (Connected x, Connected y, PseudoAffine (FibreBundle x y))
=> Connected (FibreBundle x y)
type LinearManifold m = (LinearSpace m, Manifold m)
type ScalarManifold s = (Num' s, Manifold s, Manifold (ZeroDim s))
type Num'' s = ScalarManifold s
type RealFrac'' s = (RealFrac' s, ScalarManifold s)
type RealFloat'' s = (RealFloat' s, SimpleSpace s, ScalarManifold s)