-- |
-- Module      : Math.Manifold.Real.Coordinates
-- Copyright   : (c) Justus Sagemüller 2018
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsagemue $ uni-koeln.de
-- Stability   : experimental
-- Portability : portable
-- 

{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE Rank2Types             #-}
{-# LANGUAGE GADTs                  #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE UnicodeSyntax          #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# LANGUAGE EmptyCase              #-}
{-# LANGUAGE StandaloneDeriving     #-}
{-# LANGUAGE CPP                    #-}
{-# LANGUAGE ScopedTypeVariables    #-}



module Math.Manifold.Real.Coordinates
         ( Coordinate, coordinate
         , HasCoordinates(..)
         -- * Vector space axes
         , HasXCoord(..), HasYCoord(..), HasZCoord(..)
         -- * Fibre bundle / tangent space diffs
         , location's
         , CoordDifferential(..)
         -- * Spherical coordinates
         , HasAzimuth(..)
         , HasZenithDistance(..)
         ) where


import Data.Manifold.Types.Primitive
import Data.Manifold.Types.Stiefel
import Data.Manifold.PseudoAffine
import Math.LinearMap.Category
import Math.VectorSpace.Dual
import Data.VectorSpace

import Control.Lens hiding ((<.>))
import Data.List (intercalate, transpose)

import qualified Linear as Lin

import qualified Test.QuickCheck as QC
import qualified Test.QuickCheck.Gen as QC (unGen)
import qualified Test.QuickCheck.Random as QC (mkQCGen)
import Data.Maybe (fromJust, isJust)

import qualified Numeric.IEEE as IEEE

-- | To give a custom type coordinate axes, first define an instance of this class.
class HasCoordinates m where
  -- | A unique description of a coordinate axis.
  data CoordinateIdentifier m :: *
  -- | How to use a coordinate axis for points in the containing space.
  --   This is what 'coordinate' calls under the hood.
  coordinateAsLens :: CoordinateIdentifier m -> Lens' m ℝ
  -- | Delimiters for the possible values one may choose for a given coordinate,
  --   around a point on the manifold.
  --   For example, in spherical coordinates, the 'azimuth' generally has a range
  --   of @(-'pi', 'pi')@, except at the poles where it's @(0,0)@.
  validCoordinateRange :: CoordinateIdentifier m -> m -> (ℝ,ℝ)
  validCoordinateRange CoordinateIdentifier m
_ m
_ = (-ℝ
1forall a. Fractional a => a -> a -> a
/ℝ
0, ℝ
1forall a. Fractional a => a -> a -> a
/ℝ
0)

class CoordinateIsh q m | q -> m where
  useCoordinate :: CoordinateIdentifier m -> q

instance CoordinateIsh (CoordinateIdentifier m) m where
  useCoordinate :: CoordinateIdentifier m -> CoordinateIdentifier m
useCoordinate = forall a. a -> a
id
instance (Functor f, HasCoordinates m, a ~ (ℝ -> f ℝ), b ~ (m -> f m))
          => CoordinateIsh (a -> b) m where
  useCoordinate :: CoordinateIdentifier m -> a -> b
useCoordinate = forall m. HasCoordinates m => CoordinateIdentifier m -> Lens' m ℝ
coordinateAsLens

coordinate :: CoordinateIdentifier m -> Coordinate m
coordinate :: forall m. CoordinateIdentifier m -> Coordinate m
coordinate = forall q m. CoordinateIsh q m => CoordinateIdentifier m -> q
useCoordinate

-- | A coordinate is a function that can be used both to determine the position
-- of a point on a manifold along the one of some family of (possibly curved) axes on
-- which it lies, and for moving the point along that axis.
-- Basically, this is a 'Lens' and can indeed be used with the '^.', '.~' and '%~'
-- operators.
-- 
-- @
-- 'Coordinate' m ~ 'Lens'' m 'ℝ'
-- @
-- 
-- In addition, each type may also have a way of identifying particular coordinate
-- axes. This is done with 'CoordinateIdentifier', which is what should be used
-- for /defining/ given coordinate axes.
type Coordinate m = ∀ q . CoordinateIsh q m => q

instance HasCoordinates ℝ⁰ where
  data CoordinateIdentifier ℝ⁰
  coordinateAsLens :: CoordinateIdentifier ℝ⁰ -> Lens' ℝ⁰ ℝ
coordinateAsLens CoordinateIdentifier ℝ⁰
b = case CoordinateIdentifier ℝ⁰
b of {}

instance HasCoordinates ℝ where
  data CoordinateIdentifier ℝ = RealCoord { CoordinateIdentifier ℝ -> ℝ
realAxisTfmStretch :: !ℝ }
                      deriving (CoordinateIdentifier ℝ -> CoordinateIdentifier ℝ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoordinateIdentifier ℝ -> CoordinateIdentifier ℝ -> Bool
$c/= :: CoordinateIdentifier ℝ -> CoordinateIdentifier ℝ -> Bool
== :: CoordinateIdentifier ℝ -> CoordinateIdentifier ℝ -> Bool
$c== :: CoordinateIdentifier ℝ -> CoordinateIdentifier ℝ -> Bool
Eq,Int -> CoordinateIdentifier ℝ -> ShowS
[CoordinateIdentifier ℝ] -> ShowS
CoordinateIdentifier ℝ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordinateIdentifier ℝ] -> ShowS
$cshowList :: [CoordinateIdentifier ℝ] -> ShowS
show :: CoordinateIdentifier ℝ -> String
$cshow :: CoordinateIdentifier ℝ -> String
showsPrec :: Int -> CoordinateIdentifier ℝ -> ShowS
$cshowsPrec :: Int -> CoordinateIdentifier ℝ -> ShowS
Show)
  coordinateAsLens :: CoordinateIdentifier ℝ -> Lens' ℝ ℝ
coordinateAsLens (RealCoord ℝ
μ) = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (forall a. Fractional a => a -> a -> a
/ℝ
μ) (forall a. Num a => a -> a -> a
*ℝ
μ)
  {-# INLINE coordinateAsLens #-}

instance QC.Arbitrary (CoordinateIdentifier ℝ) where
  arbitrary :: Gen (CoordinateIdentifier ℝ)
arbitrary = ℝ -> CoordinateIdentifier ℝ
RealCoord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonZero a -> a
QC.getNonZero forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: CoordinateIdentifier ℝ -> [CoordinateIdentifier ℝ]
shrink (RealCoord ℝ
μ) = [ ℝ -> CoordinateIdentifier ℝ
RealCoord ℝ
ν | ℝ
ν <- forall a. Arbitrary a => a -> [a]
QC.shrink ℝ
μ, ℝ
νforall a. Eq a => a -> a -> Bool
/=ℝ
0 ]

data OriginAxisCoord v = OriginAxisCoord
       { forall v. OriginAxisCoord v -> v
coordHeading :: !v             -- ^ Must be conjugate to heading, i.e.
       , forall v. OriginAxisCoord v -> DualVector v
coordSensor :: !(DualVector v) -- ^ @'coordSensor' <.>^ 'coordHeading' = 1@.
       }
deriving instance (Show v, Show (DualVector v)) => Show (OriginAxisCoord v)
deriving instance (Eq v, Eq (DualVector v)) => Eq (OriginAxisCoord v)

originAxisCoordAsLens :: LinearSpace v => OriginAxisCoord v -> Lens' v (Scalar v)
originAxisCoordAsLens :: forall v. LinearSpace v => OriginAxisCoord v -> Lens' v (Scalar v)
originAxisCoordAsLens (OriginAxisCoord v
v DualVector v
dv)
     = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (DualVector v
dvforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^)
            (\v
w Scalar v
c' -> v
w forall v. AdditiveGroup v => v -> v -> v
^+^ (Scalar v
c' forall a. Num a => a -> a -> a
- DualVector v
dvforall v. LinearSpace v => DualVector v -> v -> Scalar v
<.>^v
w)forall v. VectorSpace v => Scalar v -> v -> v
*^v
v)
{-# INLINE originAxisCoordAsLens #-}

instance (QC.Arbitrary v, InnerSpace v, v ~ DualVector v, Scalar v ~ ℝ)
    => QC.Arbitrary (OriginAxisCoord v) where
  arbitrary :: Gen (OriginAxisCoord v)
arbitrary = forall a. Arbitrary a => Gen a
QC.arbitrary forall a b. Gen a -> (a -> Maybe b) -> Gen b
`suchThatMap` \v
v
   -> case forall v s. (InnerSpace v, s ~ Scalar v) => v -> s
magnitudeSq v
v of
       ℝ
0 -> forall a. Maybe a
Nothing
       ℝ
v² -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord v
v (v
vforall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
v²)
  shrink :: OriginAxisCoord v -> [OriginAxisCoord v]
shrink (OriginAxisCoord v
v DualVector v
_) = [ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord v
w (v
wforall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
w²)
                                 | v
w <- forall a. Arbitrary a => a -> [a]
QC.shrink v
v
                                 , let w² :: ℝ
w² = forall v s. (InnerSpace v, s ~ Scalar v) => v -> s
magnitudeSq v
w
                                 , ℝ
w² forall a. Ord a => a -> a -> Bool
> ℝ
0 ]

instance HasCoordinates ℝ² where
  data CoordinateIdentifier ℝ² = ℝ²Coord !(OriginAxisCoord ℝ²) deriving (CoordinateIdentifier ℝ² -> CoordinateIdentifier ℝ² -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoordinateIdentifier ℝ² -> CoordinateIdentifier ℝ² -> Bool
$c/= :: CoordinateIdentifier ℝ² -> CoordinateIdentifier ℝ² -> Bool
== :: CoordinateIdentifier ℝ² -> CoordinateIdentifier ℝ² -> Bool
$c== :: CoordinateIdentifier ℝ² -> CoordinateIdentifier ℝ² -> Bool
Eq,Int -> CoordinateIdentifier ℝ² -> ShowS
[CoordinateIdentifier ℝ²] -> ShowS
CoordinateIdentifier ℝ² -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordinateIdentifier ℝ²] -> ShowS
$cshowList :: [CoordinateIdentifier ℝ²] -> ShowS
show :: CoordinateIdentifier ℝ² -> String
$cshow :: CoordinateIdentifier ℝ² -> String
showsPrec :: Int -> CoordinateIdentifier ℝ² -> ShowS
$cshowsPrec :: Int -> CoordinateIdentifier ℝ² -> ShowS
Show)
  coordinateAsLens :: CoordinateIdentifier ℝ² -> Lens' ℝ² ℝ
coordinateAsLens (ℝ²Coord OriginAxisCoord ℝ²
b) = forall v. LinearSpace v => OriginAxisCoord v -> Lens' v (Scalar v)
originAxisCoordAsLens OriginAxisCoord ℝ²
b
  {-# INLINE coordinateAsLens #-}

instance QC.Arbitrary ℝ² => QC.Arbitrary (CoordinateIdentifier ℝ²) where
  arbitrary :: Gen (CoordinateIdentifier ℝ²)
arbitrary = OriginAxisCoord ℝ² -> CoordinateIdentifier ℝ²
ℝ²Coord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: CoordinateIdentifier ℝ² -> [CoordinateIdentifier ℝ²]
shrink (ℝ²Coord OriginAxisCoord ℝ²
q) = OriginAxisCoord ℝ² -> CoordinateIdentifier ℝ²
ℝ²Coord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink OriginAxisCoord ℝ²
q

instance HasCoordinates ℝ³ where
  data CoordinateIdentifier ℝ³ = ℝ³Coord !(OriginAxisCoord ℝ³) deriving (CoordinateIdentifier ℝ³ -> CoordinateIdentifier ℝ³ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoordinateIdentifier ℝ³ -> CoordinateIdentifier ℝ³ -> Bool
$c/= :: CoordinateIdentifier ℝ³ -> CoordinateIdentifier ℝ³ -> Bool
== :: CoordinateIdentifier ℝ³ -> CoordinateIdentifier ℝ³ -> Bool
$c== :: CoordinateIdentifier ℝ³ -> CoordinateIdentifier ℝ³ -> Bool
Eq,Int -> CoordinateIdentifier ℝ³ -> ShowS
[CoordinateIdentifier ℝ³] -> ShowS
CoordinateIdentifier ℝ³ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordinateIdentifier ℝ³] -> ShowS
$cshowList :: [CoordinateIdentifier ℝ³] -> ShowS
show :: CoordinateIdentifier ℝ³ -> String
$cshow :: CoordinateIdentifier ℝ³ -> String
showsPrec :: Int -> CoordinateIdentifier ℝ³ -> ShowS
$cshowsPrec :: Int -> CoordinateIdentifier ℝ³ -> ShowS
Show)
  coordinateAsLens :: CoordinateIdentifier ℝ³ -> Lens' ℝ³ ℝ
coordinateAsLens (ℝ³Coord OriginAxisCoord ℝ³
b) = forall v. LinearSpace v => OriginAxisCoord v -> Lens' v (Scalar v)
originAxisCoordAsLens OriginAxisCoord ℝ³
b
  {-# INLINE coordinateAsLens #-}

instance QC.Arbitrary ℝ³ => QC.Arbitrary (CoordinateIdentifier ℝ³) where
  arbitrary :: Gen (CoordinateIdentifier ℝ³)
arbitrary = OriginAxisCoord ℝ³ -> CoordinateIdentifier ℝ³
ℝ³Coord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: CoordinateIdentifier ℝ³ -> [CoordinateIdentifier ℝ³]
shrink (ℝ³Coord OriginAxisCoord ℝ³
q) = OriginAxisCoord ℝ³ -> CoordinateIdentifier ℝ³
ℝ³Coord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink OriginAxisCoord ℝ³
q

instance (HasCoordinates a, HasCoordinates b) => HasCoordinates (a,b) where
  data CoordinateIdentifier (a,b) = LSubspaceCoord (CoordinateIdentifier a)
                                  | RSubspaceCoord (CoordinateIdentifier b)
  coordinateAsLens :: CoordinateIdentifier (a, b) -> Lens' (a, b) ℝ
coordinateAsLens (LSubspaceCoord CoordinateIdentifier a
ca) = forall s t a b. Field1 s t a b => Lens s t a b
_1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasCoordinates m => CoordinateIdentifier m -> Lens' m ℝ
coordinateAsLens CoordinateIdentifier a
ca
  coordinateAsLens (RSubspaceCoord CoordinateIdentifier b
cb) = forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasCoordinates m => CoordinateIdentifier m -> Lens' m ℝ
coordinateAsLens CoordinateIdentifier b
cb
  {-# INLINE coordinateAsLens #-}

deriving instance (Eq (CoordinateIdentifier a), Eq (CoordinateIdentifier b))
            => Eq (CoordinateIdentifier (a,b))
deriving instance (Show (CoordinateIdentifier a), Show (CoordinateIdentifier b))
            => Show (CoordinateIdentifier (a,b))

instance (QC.Arbitrary (CoordinateIdentifier a), QC.Arbitrary (CoordinateIdentifier b))
    => QC.Arbitrary (CoordinateIdentifier (a,b)) where
  arbitrary :: Gen (CoordinateIdentifier (a, b))
arbitrary = forall a. [Gen a] -> Gen a
QC.oneof [forall a b. CoordinateIdentifier a -> CoordinateIdentifier (a, b)
LSubspaceCoordforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>forall a. Arbitrary a => Gen a
QC.arbitrary, forall a b. CoordinateIdentifier b -> CoordinateIdentifier (a, b)
RSubspaceCoordforall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>forall a. Arbitrary a => Gen a
QC.arbitrary]
  shrink :: CoordinateIdentifier (a, b) -> [CoordinateIdentifier (a, b)]
shrink (LSubspaceCoord CoordinateIdentifier a
ba) = forall a b. CoordinateIdentifier a -> CoordinateIdentifier (a, b)
LSubspaceCoord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink CoordinateIdentifier a
ba
  shrink (RSubspaceCoord CoordinateIdentifier b
bb) = forall a b. CoordinateIdentifier b -> CoordinateIdentifier (a, b)
RSubspaceCoord forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink CoordinateIdentifier b
bb

class HasCoordinates m => HasXCoord m where
  xCoord :: Coordinate m

instance HasXCoord ℝ where
  xCoord :: Coordinate ℝ
xCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate (ℝ -> CoordinateIdentifier ℝ
RealCoord ℝ
1)
  {-# INLINE xCoord #-}
instance HasXCoord ℝ² where
  xCoord :: Coordinate ℝ²
xCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate (OriginAxisCoord ℝ² -> CoordinateIdentifier ℝ²
ℝ²Coord forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord (forall a. a -> a -> V2 a
Lin.V2 ℝ
1 ℝ
0) (forall a. a -> a -> V2 a
Lin.V2 ℝ
1 ℝ
0))
  {-# INLINE xCoord #-}
instance HasXCoord ℝ³ where
  xCoord :: Coordinate ℝ³
xCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate (OriginAxisCoord ℝ³ -> CoordinateIdentifier ℝ³
ℝ³Coord forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord (forall a. a -> a -> a -> V3 a
Lin.V3 ℝ
1 ℝ
0 ℝ
0) (forall a. a -> a -> a -> V3 a
Lin.V3 ℝ
1 ℝ
0 ℝ
0))
  {-# INLINE xCoord #-}
instance (HasXCoord v, HasCoordinates w) => HasXCoord (v,w) where
  xCoord :: Coordinate (v, w)
xCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall a b. (a -> b) -> a -> b
$ forall a b. CoordinateIdentifier a -> CoordinateIdentifier (a, b)
LSubspaceCoord forall m. HasXCoord m => Coordinate m
xCoord

class HasYCoord m where
  yCoord :: Coordinate m

instance HasYCoord ℝ² where
  yCoord :: Coordinate ℝ²
yCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate (OriginAxisCoord ℝ² -> CoordinateIdentifier ℝ²
ℝ²Coord forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord (forall a. a -> a -> V2 a
Lin.V2 ℝ
0 ℝ
1) (forall a. a -> a -> V2 a
Lin.V2 ℝ
0 ℝ
1))
  {-# INLINE yCoord #-}
instance HasYCoord ℝ³ where
  yCoord :: Coordinate ℝ³
yCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate (OriginAxisCoord ℝ³ -> CoordinateIdentifier ℝ³
ℝ³Coord forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord (forall a. a -> a -> a -> V3 a
Lin.V3 ℝ
0 ℝ
1 ℝ
0) (forall a. a -> a -> a -> V3 a
Lin.V3 ℝ
0 ℝ
1 ℝ
0))
  {-# INLINE yCoord #-}
instance HasCoordinates w => HasYCoord ((ℝ,ℝ),w) where
  yCoord :: Coordinate ((ℝ, ℝ), w)
yCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall a b. (a -> b) -> a -> b
$ forall a b. CoordinateIdentifier a -> CoordinateIdentifier (a, b)
LSubspaceCoord forall m. HasYCoord m => Coordinate m
yCoord
instance (HasXCoord w) => HasYCoord (ℝ,w) where
  yCoord :: Coordinate (ℝ, w)
yCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall a b. (a -> b) -> a -> b
$ forall a b. CoordinateIdentifier b -> CoordinateIdentifier (a, b)
RSubspaceCoord forall m. HasXCoord m => Coordinate m
xCoord

class HasZCoord m where
  zCoord :: Coordinate m

instance HasZCoord ℝ³ where
  zCoord :: Coordinate ℝ³
zCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate (OriginAxisCoord ℝ³ -> CoordinateIdentifier ℝ³
ℝ³Coord forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord (forall a. a -> a -> a -> V3 a
Lin.V3 ℝ
0 ℝ
0 ℝ
1) (forall a. a -> a -> a -> V3 a
Lin.V3 ℝ
0 ℝ
0 ℝ
1))
  {-# INLINE zCoord #-}
instance HasXCoord w => HasZCoord ((ℝ,ℝ),w) where
  zCoord :: Coordinate ((ℝ, ℝ), w)
zCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall a b. (a -> b) -> a -> b
$ forall a b. CoordinateIdentifier b -> CoordinateIdentifier (a, b)
RSubspaceCoord forall m. HasXCoord m => Coordinate m
xCoord
instance (HasYCoord w) => HasZCoord (ℝ,w) where
  zCoord :: Coordinate (ℝ, w)
zCoord = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall a b. (a -> b) -> a -> b
$ forall a b. CoordinateIdentifier b -> CoordinateIdentifier (a, b)
RSubspaceCoord forall m. HasYCoord m => Coordinate m
yCoord

instance (HasCoordinates b, HasCoordinates f)
              => HasCoordinates (FibreBundle b f) where
  data CoordinateIdentifier (FibreBundle b f)
           = BaseSpaceCoordinate (CoordinateIdentifier b)
           | FibreSpaceCoordinate (b -> CoordinateIdentifier f)
  coordinateAsLens :: CoordinateIdentifier (FibreBundle b f) -> Lens' (FibreBundle b f) ℝ
coordinateAsLens (BaseSpaceCoordinate CoordinateIdentifier b
b)
            = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\(FibreBundle b
p f
_) -> b
p)
                   (\(FibreBundle b
_ f
f) b
p -> forall b f. b -> f -> FibreBundle b f
FibreBundle b
p f
f)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. HasCoordinates m => CoordinateIdentifier m -> Lens' m ℝ
coordinateAsLens CoordinateIdentifier b
b
  coordinateAsLens (FibreSpaceCoordinate b -> CoordinateIdentifier f
b)
            = \ℝ -> f ℝ
φ pf :: FibreBundle b f
pf@(FibreBundle b
p f
f) -> case forall m. HasCoordinates m => CoordinateIdentifier m -> Lens' m ℝ
coordinateAsLens forall a b. (a -> b) -> a -> b
$ b -> CoordinateIdentifier f
b b
p of
                 (ℝ -> f ℝ) -> f -> f f
fLens -> forall b f. b -> f -> FibreBundle b f
FibreBundle b
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ℝ -> f ℝ) -> f -> f f
fLens ℝ -> f ℝ
φ f
f
  validCoordinateRange :: CoordinateIdentifier (FibreBundle b f) -> FibreBundle b f -> (ℝ, ℝ)
validCoordinateRange (BaseSpaceCoordinate CoordinateIdentifier b
b) (FibreBundle b
p f
_) = forall m. HasCoordinates m => CoordinateIdentifier m -> m -> (ℝ, ℝ)
validCoordinateRange CoordinateIdentifier b
b b
p
  validCoordinateRange (FibreSpaceCoordinate b -> CoordinateIdentifier f
bf) (FibreBundle b
p f
f)
                          = forall m. HasCoordinates m => CoordinateIdentifier m -> m -> (ℝ, ℝ)
validCoordinateRange (b -> CoordinateIdentifier f
bf b
p) f
f
  
instance ∀ b f . ( Show (CoordinateIdentifier b)
                 , Show (CoordinateIdentifier f)
                 , Eq b, Eq (CoordinateIdentifier f)
                 , QC.Arbitrary b, Show b )
    => Show (CoordinateIdentifier (FibreBundle b f)) where
  showsPrec :: Int -> CoordinateIdentifier (FibreBundle b f) -> ShowS
showsPrec Int
p (BaseSpaceCoordinate CoordinateIdentifier b
b)
      = Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
9) forall a b. (a -> b) -> a -> b
$ (String
"BaseSpaceCoordinate "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => Int -> a -> ShowS
showsPrec Int
10 CoordinateIdentifier b
b
  showsPrec Int
p (FibreSpaceCoordinate b -> CoordinateIdentifier f
bf)
      = Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
0) forall a b. (a -> b) -> a -> b
$ \String
cont ->
          String
"BaseSpaceCoordinate $ \\case {"
          forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"; " [ forall a. Show a => Int -> a -> ShowS
showsPrec Int
5 b
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
" -> "forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (b -> CoordinateIdentifier f
bf b
p) forall a b. (a -> b) -> a -> b
$ String
""
                              | b
p <- [b]
exampleArgs ]
          forall a. [a] -> [a] -> [a]
++ String
"... }" forall a. [a] -> [a] -> [a]
++ String
cont
   where exampleArgs :: [b]
         exampleArgs :: [b]
exampleArgs = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> [[b]]
go Int
1 Int
0 Int
2384148716156
          where go :: Int -> Int -> Int -> [[b]]
                go :: Int -> Int -> Int -> [[b]]
go Int
n Int
tries Int
seed
                  | forall (t :: * -> *) a. Foldable t => t a -> Int
length [b]
candidate forall a. Eq a => a -> a -> Bool
== Int
n, forall {a}. Eq a => [a] -> Bool
allDifferent [b]
candidate
                  , ([b]
shrunk:[[b]]
_) <- forall a. (a -> Bool) -> [a] -> [a]
filter (forall {a}. Eq a => [a] -> Bool
allDifferent forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map b -> CoordinateIdentifier f
bf)
                                     forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => [a] -> [[a]]
shrinkElems [b]
candidate forall a. [a] -> [a] -> [a]
++ [[b]
candidate]
                  , [] <- forall a. Int -> [a] -> [a]
take (Int
5forall a. Num a => a -> a -> a
-Int
n) forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> [[b]]
go (Int
nforall a. Num a => a -> a -> a
+Int
1) Int
0 Int
seed'
                                      = [[b]
shrunk]
                  | Int
triesforall a. Num a => a -> a -> a
*(Int
nforall a. Num a => a -> a -> a
-Int
1) forall a. Ord a => a -> a -> Bool
> Int
15  = []
                  | Bool
otherwise         = Int -> Int -> Int -> [[b]]
go Int
n (Int
triesforall a. Num a => a -> a -> a
+Int
1) Int
seed'
                 where candidate :: [b]
candidate = forall a. Int -> [a] -> [a]
take Int
n forall a b. (a -> b) -> a -> b
$ forall s a. CoArbitrary s => s -> Gen a -> a
generateFrom Int
seed forall a. Arbitrary a => Gen a
QC.arbitrary
                       seed' :: Int
seed' = forall s a. CoArbitrary s => s -> Gen a -> a
generateFrom Int
seed forall a. Arbitrary a => Gen a
QC.arbitrary
         allDifferent :: [a] -> Bool
allDifferent (a
x:[a]
ys) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a
xforall a. Eq a => a -> a -> Bool
/=) [a]
ys Bool -> Bool -> Bool
&& [a] -> Bool
allDifferent [a]
ys
         allDifferent [] = Bool
True

generateFrom :: QC.CoArbitrary s => s -> QC.Gen a -> a
generateFrom :: forall s a. CoArbitrary s => s -> Gen a -> a
generateFrom s
seed Gen a
val = forall a. Gen a -> QCGen -> Int -> a
QC.unGen (forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary s
seed Gen a
val) (Int -> QCGen
QC.mkQCGen Int
256592) Int
110818

-- | Keep length of the list, but shrink the individual elements.
shrinkElems :: QC.Arbitrary a => [a] -> [[a]]
shrinkElems :: forall a. Arbitrary a => [a] -> [[a]]
shrinkElems [a]
l = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
==forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [[a]] -> [[a]]
transpose forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a. Arbitrary a => a -> [a]
QC.shrink [a]
l


location's :: (HasCoordinates b, HasCoordinates f)
                => CoordinateIdentifier b -> Coordinate (FibreBundle b f)
location's :: forall b f.
(HasCoordinates b, HasCoordinates f) =>
CoordinateIdentifier b -> Coordinate (FibreBundle b f)
location's = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b f.
CoordinateIdentifier b -> CoordinateIdentifier (FibreBundle b f)
BaseSpaceCoordinate

class HasCoordinates m => CoordDifferential m where
  -- | Observe local, small variations (in the tangent space) of a coordinate.
  --   The idea is that @((p & coord+~δc) − p) ^. delta coord ≈ δc@, thus the name
  --   “'delta'”. Note however that this only holds exactly for flat spaces;
  --   in most manifolds it can (by design) only be understood in an asymptotic
  --   sense, i.e. used for evaluating directional derivatives of some function.
  --   In particular, @delta 'azimuth'@ is unstable near the poles of a sphere,
  --   because it has to compensate for the sensitive rotation of the @eφ@ unit vector.
  delta :: CoordinateIdentifier m -> Coordinate (TangentBundle m)

instance ( CoordDifferential m, f ~ Needle m
         , QC.Arbitrary m
         , QC.Arbitrary (CoordinateIdentifier m)
         , QC.Arbitrary (CoordinateIdentifier f) )
             => QC.Arbitrary (CoordinateIdentifier (FibreBundle m f)) where
  arbitrary :: Gen (CoordinateIdentifier (FibreBundle m f))
arbitrary = forall a. [Gen a] -> Gen a
QC.oneof [ forall b f.
CoordinateIdentifier b -> CoordinateIdentifier (FibreBundle b f)
BaseSpaceCoordinate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
                       , forall m.
CoordDifferential m =>
CoordinateIdentifier m -> Coordinate (TangentBundle m)
delta forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary ]
  shrink :: CoordinateIdentifier (FibreBundle m f)
-> [CoordinateIdentifier (FibreBundle m f)]
shrink (BaseSpaceCoordinate CoordinateIdentifier m
b) = forall b f.
CoordinateIdentifier b -> CoordinateIdentifier (FibreBundle b f)
BaseSpaceCoordinate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink CoordinateIdentifier m
b
  shrink (FibreSpaceCoordinate m -> CoordinateIdentifier f
bf) = forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
                     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink (m -> CoordinateIdentifier f
bf m
cRef)
   where cRef₀ :: m
cRef₀ = forall a. Gen a -> QCGen -> Int -> a
QC.unGen forall a. Arbitrary a => Gen a
QC.arbitrary (Int -> QCGen
QC.mkQCGen Int
534373) Int
57314
         cRef :: m
cRef = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. Arbitrary a => a -> [a]
QC.shrink m
cRef₀ forall a. [a] -> [a] -> [a]
++ [m
cRef₀]

instance CoordDifferential ℝ where
  delta :: CoordinateIdentifier ℝ -> Coordinate (TangentBundle ℝ)
delta CoordinateIdentifier ℝ
ζ = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const CoordinateIdentifier ℝ
ζ
instance CoordDifferential ℝ² where
  delta :: CoordinateIdentifier ℝ² -> Coordinate (TangentBundle ℝ²)
delta CoordinateIdentifier ℝ²
ζ = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const CoordinateIdentifier ℝ²
ζ
instance CoordDifferential ℝ³ where
  delta :: CoordinateIdentifier ℝ³ -> Coordinate (TangentBundle ℝ³)
delta CoordinateIdentifier ℝ³
ζ = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const CoordinateIdentifier ℝ³
ζ

instance (CoordDifferential a, CoordDifferential b) => CoordDifferential (a,b) where
  delta :: CoordinateIdentifier (a, b) -> Coordinate (TangentBundle (a, b))
delta (LSubspaceCoord CoordinateIdentifier a
ba) = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall a b. (a -> b) -> a -> b
$ case forall m.
CoordDifferential m =>
CoordinateIdentifier m -> Coordinate (TangentBundle m)
delta CoordinateIdentifier a
ba of
     FibreSpaceCoordinate a -> CoordinateIdentifier (Needle a)
bf -> forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate forall a b. (a -> b) -> a -> b
$ \(a
δa,b
_) -> forall a b. CoordinateIdentifier a -> CoordinateIdentifier (a, b)
LSubspaceCoord forall a b. (a -> b) -> a -> b
$ a -> CoordinateIdentifier (Needle a)
bf a
δa
  delta (RSubspaceCoord CoordinateIdentifier b
bb) = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall a b. (a -> b) -> a -> b
$ case forall m.
CoordDifferential m =>
CoordinateIdentifier m -> Coordinate (TangentBundle m)
delta CoordinateIdentifier b
bb of
     FibreSpaceCoordinate b -> CoordinateIdentifier (Needle b)
bf -> forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate forall a b. (a -> b) -> a -> b
$ \(a
_,b
δb) -> forall a b. CoordinateIdentifier b -> CoordinateIdentifier (a, b)
RSubspaceCoord forall a b. (a -> b) -> a -> b
$ b -> CoordinateIdentifier (Needle b)
bf b
δb

instance HasCoordinates S¹ where
  data CoordinateIdentifier S¹ = S¹Azimuth deriving (CoordinateIdentifier S¹ -> CoordinateIdentifier S¹ -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoordinateIdentifier S¹ -> CoordinateIdentifier S¹ -> Bool
$c/= :: CoordinateIdentifier S¹ -> CoordinateIdentifier S¹ -> Bool
== :: CoordinateIdentifier S¹ -> CoordinateIdentifier S¹ -> Bool
$c== :: CoordinateIdentifier S¹ -> CoordinateIdentifier S¹ -> Bool
Eq,Int -> CoordinateIdentifier S¹ -> ShowS
[CoordinateIdentifier S¹] -> ShowS
CoordinateIdentifier S¹ -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordinateIdentifier S¹] -> ShowS
$cshowList :: [CoordinateIdentifier S¹] -> ShowS
show :: CoordinateIdentifier S¹ -> String
$cshow :: CoordinateIdentifier S¹ -> String
showsPrec :: Int -> CoordinateIdentifier S¹ -> ShowS
$cshowsPrec :: Int -> CoordinateIdentifier S¹ -> ShowS
Show)
  coordinateAsLens :: CoordinateIdentifier S¹ -> Lens' S¹ ℝ
coordinateAsLens CoordinateIdentifier S¹
R:CoordinateIdentifierS¹_
S¹Azimuth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall r. S¹_ r -> r
φParamS¹ (forall a b. a -> b -> a
const forall r. r -> S¹_ r
S¹Polar)
  validCoordinateRange :: CoordinateIdentifier S¹ -> S¹ -> (ℝ, ℝ)
validCoordinateRange CoordinateIdentifier S¹
R:CoordinateIdentifierS¹_
S¹Azimuth S¹
_ = (-forall a. Floating a => a
pi, forall a. Floating a => a
pi)

instance QC.Arbitrary (CoordinateIdentifier S¹) where
  arbitrary :: Gen (CoordinateIdentifier S¹)
arbitrary = forall (m :: * -> *) a. Monad m => a -> m a
return CoordinateIdentifier S¹
S¹Azimuth

class HasAzimuth m where
  azimuth :: Coordinate m

instance HasAzimuth S¹ where
  azimuth :: Coordinate S¹
azimuth = forall m. CoordinateIdentifier m -> Coordinate m
coordinate CoordinateIdentifier S¹
S¹Azimuth

instance CoordDifferential S¹ where
  delta :: CoordinateIdentifier S¹ -> Coordinate (TangentBundle S¹)
delta CoordinateIdentifier S¹
R:CoordinateIdentifierS¹_
S¹Azimuth = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall m. HasXCoord m => Coordinate m
xCoord
  
instance HasCoordinates S² where
  data CoordinateIdentifier S² = S²ZenithAngle | S²Azimuth deriving (CoordinateIdentifier S² -> CoordinateIdentifier S² -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoordinateIdentifier S² -> CoordinateIdentifier S² -> Bool
$c/= :: CoordinateIdentifier S² -> CoordinateIdentifier S² -> Bool
== :: CoordinateIdentifier S² -> CoordinateIdentifier S² -> Bool
$c== :: CoordinateIdentifier S² -> CoordinateIdentifier S² -> Bool
Eq,Int -> CoordinateIdentifier S² -> ShowS
[CoordinateIdentifier S²] -> ShowS
CoordinateIdentifier S² -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoordinateIdentifier S²] -> ShowS
$cshowList :: [CoordinateIdentifier S²] -> ShowS
show :: CoordinateIdentifier S² -> String
$cshow :: CoordinateIdentifier S² -> String
showsPrec :: Int -> CoordinateIdentifier S² -> ShowS
$cshowsPrec :: Int -> CoordinateIdentifier S² -> ShowS
Show)
  coordinateAsLens :: CoordinateIdentifier S² -> Lens' S² ℝ
coordinateAsLens CoordinateIdentifier S²
R:CoordinateIdentifierS²_
S²ZenithAngle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall r. S²_ r -> r
ϑParamS² (\(S²Polar ℝ
_ ℝ
φ) ℝ
θ -> forall r. r -> r -> S²_ r
S²Polar ℝ
θ ℝ
φ)
  coordinateAsLens CoordinateIdentifier S²
R:CoordinateIdentifierS²_
S²Azimuth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall r. S²_ r -> r
φParamS² (\(S²Polar ℝ
θ ℝ
_) ℝ
φ -> forall r. r -> r -> S²_ r
S²Polar ℝ
θ ℝ
φ)
  validCoordinateRange :: CoordinateIdentifier S² -> S² -> (ℝ, ℝ)
validCoordinateRange CoordinateIdentifier S²
R:CoordinateIdentifierS²_
S²ZenithAngle S²
_ = (ℝ
0, forall a. Floating a => a
pi)
  validCoordinateRange CoordinateIdentifier S²
R:CoordinateIdentifierS²_
S²Azimuth (S²Polar ℝ
θ ℝ
_)
    | ℝ
θforall a. Ord a => a -> a -> Bool
>ℝ
0 Bool -> Bool -> Bool
&& ℝ
θforall a. Ord a => a -> a -> Bool
<forall a. Floating a => a
pi  = (-forall a. Floating a => a
pi, forall a. Floating a => a
pi)
    | Bool
otherwise    = (ℝ
0, ℝ
0)

instance QC.Arbitrary (CoordinateIdentifier S²) where
  arbitrary :: Gen (CoordinateIdentifier S²)
arbitrary = forall a. [a] -> Gen a
QC.elements [CoordinateIdentifier S²
S²Azimuth, CoordinateIdentifier S²
S²ZenithAngle]

instance HasAzimuth S² where
  azimuth :: Coordinate S²
azimuth = forall m. CoordinateIdentifier m -> Coordinate m
coordinate CoordinateIdentifier S²
S²Azimuth
  
class HasZenithDistance m where
  zenithAngle :: Coordinate m

instance HasZenithDistance S² where
  zenithAngle :: Coordinate S²
zenithAngle = forall m. CoordinateIdentifier m -> Coordinate m
coordinate CoordinateIdentifier S²
S²ZenithAngle

instance CoordDifferential S² where
  delta :: CoordinateIdentifier S² -> Coordinate (TangentBundle S²)
delta CoordinateIdentifier S²
R:CoordinateIdentifierS²_
S²ZenithAngle = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate
            forall a b. (a -> b) -> a -> b
$ \(S²Polar ℝ
θ ℝ
φ) -> let eθ :: ℝ²
eθ
                                     | ℝ
θ forall a. Ord a => a -> a -> Bool
< forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/ℝ
2   = forall m v. NaturallyEmbedded m v => m -> v
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. r -> S¹_ r
S¹Polar forall a b. (a -> b) -> a -> b
$  ℝ
φ
                                     | Bool
otherwise  = forall m v. NaturallyEmbedded m v => m -> v
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. r -> S¹_ r
S¹Polar forall a b. (a -> b) -> a -> b
$ -ℝ
φ
                                in OriginAxisCoord ℝ² -> CoordinateIdentifier ℝ²
ℝ²Coord forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord ℝ²
eθ ℝ²
eθ
  delta CoordinateIdentifier S²
R:CoordinateIdentifierS²_
S²Azimuth = forall m. CoordinateIdentifier m -> Coordinate m
coordinate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b f.
(b -> CoordinateIdentifier f)
-> CoordinateIdentifier (FibreBundle b f)
FibreSpaceCoordinate
            forall a b. (a -> b) -> a -> b
$ \(S²Polar ℝ
θ ℝ
φ) -> let eφ :: ℝ²
eφ
                                     | ℝ
θ forall a. Ord a => a -> a -> Bool
< forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/ℝ
2   = forall m v. NaturallyEmbedded m v => m -> v
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. r -> S¹_ r
S¹Polar forall a b. (a -> b) -> a -> b
$ ℝ
φ forall a. Num a => a -> a -> a
+ forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/ℝ
2
                                     | Bool
otherwise  = forall m v. NaturallyEmbedded m v => m -> v
embed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. r -> S¹_ r
S¹Polar forall a b. (a -> b) -> a -> b
$ forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/ℝ
2 forall a. Num a => a -> a -> a
- ℝ
φ
                                    sθ :: ℝ
sθ = forall a. Floating a => a -> a
sin ℝ
θ forall a. Num a => a -> a -> a
+ ℝ
tiny
                                    -- ^ Right at the poles, azimuthal movements
                                    --   become inexpressible, which manifests itself
                                    --   in giving infinite diffs. Moreover,
                                    --   we also can't retrieve tangent diffs we put
                                    --   in anymore. Arguably, this just expresses
                                    --   the fact that azimuthal changes are meaningless
                                    --   at the poles, however it violates the lens
                                    --   laws, so prevent the infinity by keeping
                                    --   sin θ very slightly above 0.
                                in OriginAxisCoord ℝ² -> CoordinateIdentifier ℝ²
ℝ²Coord forall a b. (a -> b) -> a -> b
$ forall v. v -> DualVector v -> OriginAxisCoord v
OriginAxisCoord (ℝ²
eφforall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*ℝ
sθ) (ℝ²
eφforall v s.
(VectorSpace v, s ~ Scalar v, Fractional s) =>
v -> s -> v
^/ℝ
sθ)

-- | @2e-162@. A value that's so small that it can't notably disturb any nonzero value
--   you might realistically encounter (i.e. @x + tiny == x@), but still large enough
--   that ratios can reliably be represented (i.e. @x * tiny / tiny == x@).
tiny :: ℝ
tiny :: ℝ
tiny = forall a. IEEE a => a -> a -> a
IEEE.bisectIEEE forall a. IEEE a => a
IEEE.minNormal forall a. IEEE a => a
IEEE.epsilon
                

suchThatMap :: QC.Gen a -> (a -> Maybe b) -> QC.Gen b
#if !MIN_VERSION_QuickCheck(2,11,0)
gen `suchThatMap` f =
  fmap fromJust $ fmap f gen `QC.suchThat` isJust
#else
suchThatMap :: forall a b. Gen a -> (a -> Maybe b) -> Gen b
suchThatMap = forall a b. Gen a -> (a -> Maybe b) -> Gen b
QC.suchThatMap
#endif