{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE LambdaCase #-}
module Data.Manifold.Types.Primitive (
Real0, Real1, RealPlus, Real2, Real3
, Sphere0, Sphere1, Sphere2
, Projective0, Projective1, Projective2
, Disk1, Disk2, Cone, OpenCone
, FibreBundle(..), TangentBundle
, EmptyMfd(..), ZeroDim(..)
, ℝ, ℝ⁰, ℝ¹, ℝ², ℝ³, ℝ⁴
, S⁰, S⁰_(..), otherHalfSphere, S¹, S¹_(..), pattern S¹, S², S²_(..), pattern S²
, ℝP⁰, ℝP⁰_(..), ℝP¹, ℝP¹_(..), pattern ℝP¹, ℝP², ℝP²_(..), pattern ℝP²
, D¹, D¹_(..), fromIntv0to1, D², D²_(..), pattern D²
, ℝay, ℝay_
, CD¹(..), Cℝay(..)
, type (⊗)(..)
, NaturallyEmbedded(..)
, GraphWindowSpec(..), Endomorphism, (^), (^.), EqFloating
, empty
) where
import Math.Manifold.Core.Types
import Math.Manifold.Core.PseudoAffine (FibreBundle(..), TangentBundle, Semimanifold(..))
import Data.VectorSpace
import Data.VectorSpace.Free
import Linear.V2
import Linear.V3
import Math.VectorSpace.ZeroDimensional
import Data.AffineSpace
import Data.Basis
import Data.Void
import Data.Monoid
import Data.Fixed (mod')
import Math.LinearMap.Category (type (⊗)())
import Control.Applicative (Const(..), Alternative(..))
import Control.Lens ((^.))
import Data.Binary
import qualified Prelude
import Control.Category.Constrained.Prelude hiding ((^))
import Control.Arrow.Constrained
import Data.Embedding
import qualified Test.QuickCheck as QC
import qualified Test.QuickCheck.Function as QC (Function (..), functionMap)
import qualified Text.Show.Pragmatic as SP
type EqFloating f = (Eq f, Ord f, Floating f)
data GraphWindowSpec = GraphWindowSpec {
GraphWindowSpec -> Double
lBound, GraphWindowSpec -> Double
rBound, GraphWindowSpec -> Double
bBound, GraphWindowSpec -> Double
tBound :: Double
, GraphWindowSpec -> Int
xResolution, GraphWindowSpec -> Int
yResolution :: Int
}
class NaturallyEmbedded m v where
embed :: m -> v
coEmbed :: v -> m
instance (VectorSpace y) => NaturallyEmbedded x (x,y) where
embed :: x -> (x, y)
embed x
x = (x
x, y
forall v. AdditiveGroup v => v
zeroV)
coEmbed :: (x, y) -> x
coEmbed (x
x,y
_) = x
x
instance (VectorSpace y, VectorSpace z) => NaturallyEmbedded x ((x,y),z) where
embed :: x -> ((x, y), z)
embed x
x = (x -> (x, y)
forall m v. NaturallyEmbedded m v => m -> v
embed x
x, z
forall v. AdditiveGroup v => v
zeroV)
coEmbed :: ((x, y), z) -> x
coEmbed ((x, y)
x,z
_) = (x, y) -> x
forall m v. NaturallyEmbedded m v => v -> m
coEmbed (x, y)
x
instance (Num s, s~s') => NaturallyEmbedded (ZeroDim s) (ZeroDim s') where
embed :: ZeroDim s -> ZeroDim s'
embed = ZeroDim s -> ZeroDim s'
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: ZeroDim s' -> ZeroDim s
coEmbed = ZeroDim s' -> ZeroDim s
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
instance NaturallyEmbedded ℝ ℝ where embed :: Double -> Double
embed = Double -> Double
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: Double -> Double
coEmbed = Double -> Double
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
instance (Num s, s~s') => NaturallyEmbedded (V2 s) (V2 s') where
embed :: V2 s -> V2 s'
embed = V2 s -> V2 s'
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: V2 s' -> V2 s
coEmbed = V2 s' -> V2 s
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
instance (Num s, s~s') => NaturallyEmbedded (V3 s) (V3 s') where
embed :: V3 s -> V3 s'
embed = V3 s -> V3 s'
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: V3 s' -> V3 s
coEmbed = V3 s' -> V3 s
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
instance (Num s, s~s') => NaturallyEmbedded (V4 s) (V4 s') where
embed :: V4 s -> V4 s'
embed = V4 s -> V4 s'
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: V4 s' -> V4 s
coEmbed = V4 s' -> V4 s
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
instance (RealFloat s, VectorSpace s, s'~s) => NaturallyEmbedded (S⁰_ s) s' where
embed :: S⁰_ s -> s'
embed S⁰_ s
PositiveHalfSphere = s'
1
embed S⁰_ s
NegativeHalfSphere = -s'
1
coEmbed :: s' -> S⁰_ s
coEmbed s'
x | s'
xs' -> s' -> Bool
forall a. Ord a => a -> a -> Bool
>=s'
0 = S⁰_ s
forall r. S⁰_ r
PositiveHalfSphere
| Bool
otherwise = S⁰_ s
forall r. S⁰_ r
NegativeHalfSphere
instance (RealFloat s, s'~s) => NaturallyEmbedded (S¹_ s) (V2 s') where
embed :: S¹_ s -> V2 s'
embed (S¹Polar s
φ) = s -> s -> V2 s
forall a. a -> a -> V2 a
V2 (s -> s
forall a. Floating a => a -> a
cos s
φ) (s -> s
forall a. Floating a => a -> a
sin s
φ)
coEmbed :: V2 s' -> S¹_ s
coEmbed (V2 s'
x s'
y) = s' -> S¹_ s
forall r. r -> S¹_ r
S¹Polar (s' -> S¹_ s) -> s' -> S¹_ s
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s' -> s' -> s'
forall a. RealFloat a => a -> a -> a
atan2 s'
y s'
x
instance (RealFloat s, s'~s) => NaturallyEmbedded (S²_ s) (V3 s') where
embed :: S²_ s -> V3 s'
embed (S²Polar s
ϑ s
φ) = s -> s -> s -> V3 s
forall a. a -> a -> a -> V3 a
V3 (s -> s
forall a. Floating a => a -> a
cos s
φ s -> s -> s
forall a. Num a => a -> a -> a
* s
sϑ) (s -> s
forall a. Floating a => a -> a
sin s
φ s -> s -> s
forall a. Num a => a -> a -> a
* s
sϑ) (s -> s
forall a. Floating a => a -> a
cos s
ϑ)
where sϑ :: s
sϑ = s -> s
forall a. Floating a => a -> a
sin s
ϑ
{-# INLINE embed #-}
coEmbed :: V3 s' -> S²_ s
coEmbed (V3 s'
x s'
y s'
z) = s' -> s' -> S²_ s'
forall r. r -> r -> S²_ r
S²Polar (s' -> s' -> s'
forall a. RealFloat a => a -> a -> a
atan2 s'
rxy s'
z) (s' -> s' -> s'
forall a. RealFloat a => a -> a -> a
atan2 s'
y s'
x)
where rxy :: s'
rxy = s' -> s'
forall a. Floating a => a -> a
sqrt (s' -> s') -> s' -> s'
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s'
xs' -> Int -> s'
forall a. Num a => a -> Int -> a
^Int
2 s' -> s' -> s'
forall a. Num a => a -> a -> a
+ s'
ys' -> Int -> s'
forall a. Num a => a -> Int -> a
^Int
2
{-# INLINE coEmbed #-}
instance (RealFloat s, s'~s) => NaturallyEmbedded (ℝP²_ s) (V3 s') where
embed :: ℝP²_ s -> V3 s'
embed (HemisphereℝP²Polar s
θ s
φ) = s -> s -> s -> V3 s
forall a. a -> a -> a -> V3 a
V3 (s
cθ s -> s -> s
forall a. Num a => a -> a -> a
* s -> s
forall a. Floating a => a -> a
cos s
φ) (s
cθ s -> s -> s
forall a. Num a => a -> a -> a
* s -> s
forall a. Floating a => a -> a
sin s
φ) (s -> s
forall a. Floating a => a -> a
sin s
θ)
where cθ :: s
cθ = s -> s
forall a. Floating a => a -> a
cos s
θ
coEmbed :: V3 s' -> ℝP²_ s
coEmbed (V3 s'
x s'
y s'
z) = s' -> s' -> ℝP²_ s'
forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar (s' -> s' -> s'
forall a. RealFloat a => a -> a -> a
atan2 s'
rxy s'
z) (s' -> s' -> s'
forall a. RealFloat a => a -> a -> a
atan2 s'
y s'
x)
where rxy :: s'
rxy = s' -> s'
forall a. Floating a => a -> a
sqrt (s' -> s') -> s' -> s'
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s'
xs' -> Int -> s'
forall a. Num a => a -> Int -> a
^Int
2 s' -> s' -> s'
forall a. Num a => a -> a -> a
+ s'
ys' -> Int -> s'
forall a. Num a => a -> Int -> a
^Int
2
instance (RealFloat s, VectorSpace s, s'~s) => NaturallyEmbedded (D¹_ s) s' where
embed :: D¹_ s -> s'
embed = D¹_ s -> s'
forall r. D¹_ r -> r
xParamD¹
coEmbed :: s' -> D¹_ s
coEmbed = s -> D¹_ s
forall r. r -> D¹_ r
D¹ (s -> D¹_ s) -> (s -> s) -> s -> D¹_ 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 -> s
forall a. Ord a => a -> a -> a
max (-s
1) (s -> s) -> (s -> s) -> s -> 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 -> s
forall a. Ord a => a -> a -> a
min s
1
instance (Real s, NaturallyEmbedded x p, s ~ Scalar (Needle x))
=> NaturallyEmbedded (Cℝay x) (p, s) where
embed :: Cℝay x -> (p, s)
embed (Cℝay Scalar (Needle x)
h x
p) = (x -> p
forall m v. NaturallyEmbedded m v => m -> v
embed x
p, s
Scalar (Needle x)
h)
coEmbed :: (p, s) -> Cℝay x
coEmbed (p
v,s
z) = Scalar (Needle x) -> x -> Cℝay x
forall x. Scalar (Needle x) -> x -> Cℝay x
Cℝay (s -> s -> s
forall a. Ord a => a -> a -> a
max s
0 s
z) (p -> x
forall m v. NaturallyEmbedded m v => v -> m
coEmbed p
v)
type Endomorphism a = a->a
type ℝ¹ = V1 ℝ
type ℝ² = V2 ℝ
type ℝ³ = V3 ℝ
type ℝ⁴ = V4 ℝ
type ℝay = Cℝay ℝ⁰
type ℝay_ r = Cℝay (ZeroDim r)
type Real0 = ℝ⁰
type Real1 = ℝ
type RealPlus = ℝay
type Real2 = ℝ²
type Real3 = ℝ³
type Sphere0 = S⁰
type Sphere1 = S¹
type Sphere2 = S²
type Projective0 = ℝP⁰
type Projective1 = ℝP¹
type Projective2 = ℝP²
type Disk1 = D¹
type Disk2 = D²
type Cone = CD¹
type OpenCone = Cℝay
infixr 8 ^
(^) :: Num a => a -> Int -> a
^ :: a -> Int -> a
(^) = a -> Int -> a
forall a b. (Num a, Integral b) => a -> b -> a
(Prelude.^)
instance QC.Arbitrary S⁰ where
arbitrary :: Gen S⁰
arbitrary = (\Bool
hsph -> if Bool
hsph then S⁰
forall r. S⁰_ r
PositiveHalfSphere else S⁰
forall r. S⁰_ r
NegativeHalfSphere)
(Bool -> S⁰) -> Gen Bool -> Gen S⁰
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
QC.arbitrary
instance QC.CoArbitrary S⁰ where
coarbitrary :: S⁰ -> Gen b -> Gen b
coarbitrary S⁰
PositiveHalfSphere = Int -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
2255841931547 :: Int)
coarbitrary S⁰
NegativeHalfSphere = Int -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
1710032008738 :: Int)
instance QC.Function S⁰ where
function :: (S⁰ -> b) -> S⁰ :-> b
function = (S⁰ -> Bool) -> (Bool -> S⁰) -> (S⁰ -> b) -> S⁰ :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap (\case {S⁰
PositiveHalfSphere->Bool
True; S⁰
NegativeHalfSphere->Bool
False})
(\case {Bool
True->S⁰
forall r. S⁰_ r
PositiveHalfSphere; Bool
False->S⁰
forall r. S⁰_ r
NegativeHalfSphere})
instance SP.Show S⁰ where
showsPrec :: Int -> S⁰ -> ShowS
showsPrec = Int -> S⁰ -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec
instance QC.Arbitrary S¹ where
arbitrary :: Gen S¹
arbitrary = Double -> S¹
forall r. r -> S¹_ r
S¹Polar (Double -> S¹) -> (Double -> Double) -> Double -> 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
. (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Num a => a -> a -> a
-) (Double -> Double) -> (Double -> Double) -> Double -> Double
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
. (Double -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`(Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi))
(Double -> S¹) -> Gen Double -> Gen S¹
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
QC.arbitrary
shrink :: S¹ -> [S¹]
shrink (S¹Polar Double
φ) = Double -> S¹
forall r. r -> S¹_ r
S¹Polar (Double -> S¹) -> (Double -> Double) -> Double -> 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
. (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
12Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> S¹) -> [Double] -> [S¹]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Double -> [Double]
forall a. Arbitrary a => a -> [a]
QC.shrink (Double
φDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
12Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall a. Floating a => a
pi)
instance QC.CoArbitrary S¹ where
coarbitrary :: S¹ -> Gen b -> Gen b
coarbitrary (S¹Polar Double
φ) = Double -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary Double
φ
instance QC.Function S¹ where
function :: (S¹ -> b) -> S¹ :-> b
function = (S¹ -> Double) -> (Double -> S¹) -> (S¹ -> b) -> S¹ :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap (\(S¹Polar Double
φ) -> Double -> Double
forall a. Floating a => a -> a
tan (Double -> Double) -> Double -> Double
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Double
φDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double -> S¹
forall r. r -> S¹_ r
S¹Polar (Double -> S¹) -> (Double -> Double) -> Double -> 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
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
2) (Double -> Double) -> (Double -> Double) -> Double -> Double
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
. Double -> Double
forall a. Floating a => a -> a
atan)
instance SP.Show S¹ where
showsPrec :: Int -> S¹ -> ShowS
showsPrec Int
p (S¹Polar Double
φ) = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
9) (ShowS -> ShowS) -> ShowS -> ShowS
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (String
"S¹Polar "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 -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 Double
φ
instance QC.Arbitrary S² where
arbitrary :: Gen S²
arbitrary = ( \Double
θ Double
φ -> Double -> Double -> S²
forall r. r -> r -> S²_ r
S²Polar (Double
θDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`Double
forall a. Floating a => a
pi) (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
φDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`(Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi))) )
(Double -> Double -> S²) -> Gen Double -> Gen (Double -> S²)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
QC.arbitraryGen (Double -> S²) -> Gen Double -> Gen S²
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*>Gen Double
forall a. Arbitrary a => Gen a
QC.arbitrary
shrink :: S² -> [S²]
shrink (S²Polar Double
θ Double
φ) = (Double -> Double -> S²) -> (Double, Double) -> S²
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 Double -> Double -> S²
forall r. r -> r -> S²_ r
S²Polar ((Double, Double) -> S²)
-> ((Double, Double) -> (Double, Double)) -> (Double, Double) -> 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
. (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
12Scalar (Double, Double) -> (Double, Double) -> (Double, Double)
forall v. VectorSpace v => Scalar v -> v -> v
*^) ((Double, Double) -> S²) -> [(Double, Double)] -> [S²]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> (Double, Double) -> [(Double, Double)]
forall a. Arbitrary a => a -> [a]
QC.shrink (Double
θDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
12Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall a. Floating a => a
pi, Double
φDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
12Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall a. Floating a => a
pi)
instance QC.CoArbitrary S² where
coarbitrary :: S² -> Gen b -> Gen b
coarbitrary (S²Polar Double
0 Double
φ) = Int -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
544317577041 :: Int)
coarbitrary (S²Polar Double
θ Double
φ)
| Double
θ Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
forall a. Floating a => a
pi = (Double, Double) -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Double
θ,Double
φ)
| Bool
otherwise = Int -> Gen b -> Gen b
forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
1771964485166 :: Int)
instance QC.Function S² where
function :: (S² -> b) -> S² :-> b
function = (S² -> (Double, Double))
-> ((Double, Double) -> S²) -> (S² -> b) -> S² :-> b
forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap (\(S²Polar Double
θ Double
φ) -> (Double -> Double
forall a. Floating a => a -> a
cos Double
φ, Double -> Double
forall a. Floating a => a -> a
sin Double
φ)(Double, Double) -> Double -> (Double, Double)
forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*Double -> Double
forall a. Floating a => a -> a
tan (Double
θDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2))
(\(Double
x,Double
y) -> Double -> Double -> S²
forall r. r -> r -> S²_ r
S²Polar (Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double -> Double
forall a. Floating a => a -> a
atan (Double -> Double) -> (Double -> Double) -> Double -> Double
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
. Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Double
xDouble -> Int -> Double
forall a. Num a => a -> Int -> a
^Int
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
yDouble -> Int -> Double
forall a. Num a => a -> Int -> a
^Int
2)) (Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
y Double
x))
instance SP.Show S² where
showsPrec :: Int -> S² -> ShowS
showsPrec Int
p (S²Polar Double
θ Double
φ) = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
9) (ShowS -> ShowS) -> ShowS -> ShowS
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (String
"S²Polar "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 -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 Double
θ 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
. Int -> Double -> ShowS
forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 Double
φ
instance QC.Arbitrary ℝP⁰ where
arbitrary :: Gen ℝP⁰
arbitrary = ℝP⁰ -> Gen ℝP⁰
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure ℝP⁰
forall r. ℝP⁰_ r
ℝPZero
instance QC.Arbitrary ℝP¹ where
arbitrary :: Gen ℝP¹
arbitrary = ( \Double
θ -> Double -> ℝP¹
forall r. r -> ℝP¹_ r
HemisphereℝP¹Polar (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
θDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`Double
forall a. Floating a => a
pi)) ) (Double -> ℝP¹) -> Gen Double -> Gen ℝP¹
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
QC.arbitrary
shrink :: ℝP¹ -> [ℝP¹]
shrink (HemisphereℝP¹Polar Double
θ) = Double -> ℝP¹
forall r. r -> ℝP¹_ r
HemisphereℝP¹Polar (Double -> ℝP¹) -> (Double -> Double) -> Double -> ℝP¹
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
. (Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
6Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> ℝP¹) -> [Double] -> [ℝP¹]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Double -> [Double]
forall a. Arbitrary a => a -> [a]
QC.shrink (Double
θDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
6Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall a. Floating a => a
pi)
instance QC.Arbitrary ℝP² where
arbitrary :: Gen ℝP²
arbitrary = ( \Double
θ Double
φ -> Double -> Double -> ℝP²
forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar (Double
θDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
2) (Double
forall a. Floating a => a
pi Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
φDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`(Double
2Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
pi))) )
(Double -> Double -> ℝP²) -> Gen Double -> Gen (Double -> ℝP²)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
QC.arbitraryGen (Double -> ℝP²) -> Gen Double -> Gen ℝP²
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*>Gen Double
forall a. Arbitrary a => Gen a
QC.arbitrary
shrink :: ℝP² -> [ℝP²]
shrink (HemisphereℝP²Polar Double
θ Double
φ) = [ Double -> Double -> ℝP²
forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar (Double
θ'Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
6) (Double
φ'Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
forall a. Floating a => a
piDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
12)
| Double
θ' <- Double -> [Double]
forall a. Arbitrary a => a -> [a]
QC.shrink (Double
θDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
6Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall a. Floating a => a
pi)
, Double
φ' <- Double -> [Double]
forall a. Arbitrary a => a -> [a]
QC.shrink (Double
φDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
12Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
forall a. Floating a => a
pi) ]
instance QC.Arbitrary D¹ where
arbitrary :: Gen D¹
arbitrary = Double -> D¹
forall r. r -> D¹_ r
D¹ (Double -> D¹) -> (Double -> Double) -> Double -> D¹
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
. (\Double
x -> (Double
xDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) (Double -> D¹) -> Gen Double -> Gen D¹
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
QC.arbitrary
shrink :: D¹ -> [D¹]
shrink (D¹ Double
p) = Double -> D¹
forall r. r -> D¹_ r
D¹ (Double -> D¹) -> (Double -> Double) -> Double -> D¹
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
. (\Double
x -> (Double
xDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) (Double -> D¹) -> [Double] -> [D¹]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Double -> [Double]
forall a. Arbitrary a => a -> [a]
QC.shrink Double
p
instance QC.Arbitrary D² where
arbitrary :: Gen D²
arbitrary = Double -> Double -> D²
forall r. r -> r -> D²_ r
D²Polar (Double -> Double -> D²)
-> (Double -> Double) -> Double -> Double -> D²
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
. (\Double
x -> Double
xDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`Double
1) (Double -> Double -> D²) -> Gen Double -> Gen (Double -> D²)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
QC.arbitrary
Gen (Double -> D²) -> Gen Double -> Gen D²
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> (S¹ -> Double
forall r. S¹_ r -> r
φParamS¹ (S¹ -> Double) -> Gen S¹ -> Gen Double
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen S¹
forall a. Arbitrary a => Gen a
QC.arbitrary)
shrink :: D² -> [D²]
shrink (D²Polar Double
r Double
φ) = Double -> Double -> D²
forall r. r -> r -> D²_ r
D²Polar (Double -> Double -> D²)
-> (Double -> Double) -> Double -> Double -> D²
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
. (\Double
x -> (Double
xDouble -> Double -> Double
forall a. Real a => a -> a -> a
`mod'`Double
2) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) (Double -> Double -> D²) -> [Double] -> [Double -> D²]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Double -> [Double]
forall a. Arbitrary a => a -> [a]
QC.shrink Double
r
[Double -> D²] -> [Double] -> [D²]
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> (S¹ -> Double
forall r. S¹_ r -> r
φParamS¹ (S¹ -> Double) -> [S¹] -> [Double]
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> S¹ -> [S¹]
forall a. Arbitrary a => a -> [a]
QC.shrink (Double -> S¹
forall r. r -> S¹_ r
S¹Polar Double
φ))
instance (SP.Show m, SP.Show f) => SP.Show (FibreBundle m f) where
showsPrec :: Int -> FibreBundle m f -> ShowS
showsPrec Int
p (FibreBundle m
m f
v) = Bool -> ShowS -> ShowS
showParen (Int
pInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
9)
(ShowS -> ShowS) -> ShowS -> ShowS
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (String
"FibreBundle "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 -> m -> ShowS
forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 m
m
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
. Int -> f -> ShowS
forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 f
v
instance (QC.Arbitrary m, QC.Arbitrary f) => QC.Arbitrary (FibreBundle m f) where
arbitrary :: Gen (FibreBundle m f)
arbitrary = m -> f -> FibreBundle m f
forall b f. b -> f -> FibreBundle b f
FibreBundle (m -> f -> FibreBundle m f) -> Gen m -> Gen (f -> FibreBundle m f)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> Gen m
forall a. Arbitrary a => Gen a
QC.arbitrary Gen (f -> FibreBundle m f) -> Gen f -> Gen (FibreBundle m f)
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Applicative f r t, ObjectMorphism r a b,
ObjectMorphism t (f a) (f b), Object t (t (f a) (f b)),
ObjectPair r (r a b) a, ObjectPair t (f (r a b)) (f a), Object r a,
Object r b) =>
t (f (r a b)) (t (f a) (f b))
<*> Gen f
forall a. Arbitrary a => Gen a
QC.arbitrary
shrink :: FibreBundle m f -> [FibreBundle m f]
shrink (FibreBundle m
m f
v) = [ m -> f -> FibreBundle m f
forall b f. b -> f -> FibreBundle b f
FibreBundle m
m' f
v'
| m
m' <- m -> [m]
forall a. Arbitrary a => a -> [a]
QC.shrink m
m
, f
v' <- f -> [f]
forall a. Arbitrary a => a -> [a]
QC.shrink f
v ]
instance Binary (ZeroDim a) where
put :: ZeroDim a -> Put
put ZeroDim a
Origin = () -> Put
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ()
get :: Get (ZeroDim a)
get = ZeroDim a -> Get (ZeroDim a)
forall (m :: * -> *) a. Monad m (->) => a -> m a
return ZeroDim a
forall s. ZeroDim s
Origin
instance Binary S⁰
instance Binary S¹
instance Binary S²
instance Binary ℝP⁰
instance Binary ℝP¹
instance Binary ℝP²
instance Binary D¹
instance Binary D²
instance (Binary y, Binary (Scalar (Needle y))) => Binary (CD¹ y)
instance (Binary y, Binary (Scalar (Needle y))) => Binary (Cℝay y)