-- |
-- Module      : Data.Manifold.Types.Primitive
-- Copyright   : (c) Justus Sagemüller 2015
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 
-- Several low-dimensional manifolds, represented in some simple way as Haskell
-- data types. All these are in the 'PseudoAffine' class.
-- 
-- Also included in this module are some misc helper constraints etc., which don't really
-- belong here.


{-# 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 (
        -- * Index / ASCII names
          Real0, Real1, RealPlus, Real2, Real3
        , Sphere0, Sphere1, Sphere2
        , Projective0, Projective1, Projective2
        , Disk1, Disk2, Cone, OpenCone
        , FibreBundle(..), TangentBundle
        -- * Trivial manifolds
        , EmptyMfd(..), ZeroDim(..)
        -- * Linear manifolds
        , ℝ, ℝ⁰, ℝ¹, ℝ², ℝ³, ℝ⁴
        -- * Hyperspheres
        , S⁰, S⁰_(..), otherHalfSphere, S¹, S¹_(..), pattern S¹, S², S²_(..), pattern S²
        -- * Projective spaces
        , ℝP⁰, ℝP⁰_(..), ℝP¹, ℝP¹_(..), pattern ℝP¹,  ℝP²,  ℝP²_(..), pattern ℝP²
        -- * Intervals\/disks\/cones
        , D¹, D¹_(..), fromIntv0to1, D², D²_(..), pattern D²
        , ℝay, ℝay_
        , CD¹(..), Cℝay(..)
        -- * Tensor products
        , type (⊗)(..)
        -- * Utility (deprecated)
        , 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, 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 = (forall m v. NaturallyEmbedded m v => m -> v
embed x
x, forall v. AdditiveGroup v => v
zeroV)
  coEmbed :: ((x, y), z) -> x
coEmbed ((x, y)
x,z
_) = 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 = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: ZeroDim s' -> ZeroDim s
coEmbed = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
instance NaturallyEmbedded ℝ  ℝ  where embed :: Double -> Double
embed = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: Double -> Double
coEmbed = 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 = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: V2 s' -> V2 s
coEmbed = 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 = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: V3 s' -> V3 s
coEmbed = 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 = forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id; coEmbed :: V4 s' -> V4 s
coEmbed = 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'
xforall a. Ord a => a -> a -> Bool
>=s'
0       = forall r. S⁰_ r
PositiveHalfSphere
            | Bool
otherwise  = 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
φ) = forall a. a -> a -> V2 a
V2 (forall a. Floating a => a -> a
cos s
φ) (forall a. Floating a => a -> a
sin s
φ)
  coEmbed :: V2 s' -> S¹_ s
coEmbed (V2 s'
x s'
y) = forall r. r -> S¹_ r
S¹Polar forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ 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
φ) = forall a. a -> a -> a -> V3 a
V3 (forall a. Floating a => a -> a
cos s
φ forall a. Num a => a -> a -> a
* s
sϑ) (forall a. Floating a => a -> a
sin s
φ forall a. Num a => a -> a -> a
* s
sϑ) (forall a. Floating a => a -> a
cos s
ϑ)
   where 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) = forall r. r -> r -> S²_ r
S²Polar (forall a. RealFloat a => a -> a -> a
atan2 s
rxy s'
z) (forall a. RealFloat a => a -> a -> a
atan2 s'
y s'
x)
   where rxy :: s
rxy = forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s'
xforall a. Num a => a -> Int -> a
^Int
2 forall a. Num a => a -> a -> a
+ s'
yforall 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
φ) = forall a. a -> a -> a -> V3 a
V3 (s
cθ forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos s
φ) (s
cθ forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin s
φ) (forall a. Floating a => a -> a
sin s
θ)
   where cθ :: s
cθ = forall a. Floating a => a -> a
cos s
θ
  coEmbed :: V3 s' -> ℝP²_ s
coEmbed (V3 s'
x s'
y s'
z) = forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar (forall a. RealFloat a => a -> a -> a
atan2 s
rxy s'
z) (forall a. RealFloat a => a -> a -> a
atan2 s'
y s'
x)
   where rxy :: s
rxy = forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ s'
xforall a. Num a => a -> Int -> a
^Int
2 forall a. Num a => a -> a -> a
+ s'
yforall 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 = forall r. D¹_ r -> r
xParamD¹
  coEmbed :: s' -> D¹_ s
coEmbed = forall r. r -> D¹_ r
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
. forall a. Ord a => a -> a -> a
max (-s
1) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Ord a => a -> a -> 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) = (forall m v. NaturallyEmbedded m v => m -> v
embed x
p, Scalar (Needle x)
h)
  coEmbed :: (p, s) -> Cℝay x
coEmbed (p
v,s
z) = forall x. Scalar (Needle x) -> x -> Cℝay x
Cℝay (forall a. Ord a => a -> a -> a
max s
0 s
z) (forall m v. NaturallyEmbedded m v => v -> m
coEmbed p
v)



type Endomorphism a = a->a


type ℝ¹ = V1 ℝ
type ℝ² = V2 ℝ
type ℝ³ = V3 ℝ
type ℝ⁴ = V4 ℝ


-- | Better known as ℝ⁺ (which is not a legal Haskell name), the ray
--   of positive numbers (including zero, i.e. closed on one end).
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
^ :: forall a. Num 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 forall r. S⁰_ r
PositiveHalfSphere else forall r. S⁰_ r
NegativeHalfSphere)
               forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
instance QC.CoArbitrary S⁰ where
  coarbitrary :: forall b. S⁰ -> Gen b -> Gen b
coarbitrary S⁰
PositiveHalfSphere = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
2255841931547 :: Int)
  coarbitrary S⁰
NegativeHalfSphere = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
1710032008738 :: Int)
instance QC.Function S⁰ where
  function :: forall b. (S⁰ -> b) -> S⁰ :-> b
function = 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->forall r. S⁰_ r
PositiveHalfSphere; Bool
False->forall r. S⁰_ r
NegativeHalfSphere})
instance SP.Show S⁰ where
  showsPrec :: Int -> S⁰ -> ShowS
showsPrec = forall a. Show a => Int -> a -> ShowS
showsPrec

instance QC.Arbitrary S¹ where
  arbitrary :: Gen S¹
arbitrary = forall r. r -> S¹_ r
S¹Polar forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall a. Floating a => a
piforall a. Num a => a -> a -> a
-) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall a. Real a => a -> a -> a
`mod'`(Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi))
               forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: S¹ -> [S¹]
shrink (S¹Polar Double
φ) = forall r. r -> S¹_ r
S¹Polar forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
12forall a. Num a => a -> a -> a
*) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink (Double
φforall a. Num a => a -> a -> a
*Double
12forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi)
instance QC.CoArbitrary S¹ where
  coarbitrary :: forall b. S¹ -> Gen b -> Gen b
coarbitrary (S¹Polar Double
φ) = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary Double
φ
instance QC.Function S¹ where
  function :: forall b. (S¹ -> b) -> S¹ :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap (\(S¹Polar Double
φ) -> forall a. Floating a => a -> a
tan forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Double
φforall a. Fractional a => a -> a -> a
/Double
2) (forall r. r -> S¹_ r
S¹Polar forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall a. Num a => a -> a -> a
*Double
2) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Floating a => a -> a
atan)
instance SP.Show S¹ where
  showsPrec :: Int -> S¹ -> ShowS
showsPrec Int
p (S¹Polar Double
φ) = Bool -> ShowS -> ShowS
showParen (Int
pforall a. Ord a => a -> a -> Bool
>Int
9) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (String
"S¹Polar "forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 Double
φ

instance QC.Arbitrary S² where
  arbitrary :: Gen S²
arbitrary = ( \Double
θ Double
φ -> forall r. r -> r -> S²_ r
S²Polar (Double
θforall a. Real a => a -> a -> a
`mod'`forall a. Floating a => a
pi) (forall a. Floating a => a
pi forall a. Num a => a -> a -> a
- (Double
φforall a. Real a => a -> a -> a
`mod'`(Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi))) )
               forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitraryforall (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))
<*>forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: S² -> [S²]
shrink (S²Polar Double
θ Double
φ) = 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 r. r -> r -> S²_ r
S²Polar forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
12forall v. VectorSpace v => Scalar v -> v -> v
*^) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink (Double
θforall a. Num a => a -> a -> a
*Double
12forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi, Double
φforall a. Num a => a -> a -> a
*Double
12forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi)
instance QC.CoArbitrary S² where
  coarbitrary :: forall b. S² -> Gen b -> Gen b
coarbitrary (S²Polar Double
0 Double
φ) = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
544317577041 :: Int)
  coarbitrary (S²Polar Double
θ Double
φ)
   | Double
θ forall a. Ord a => a -> a -> Bool
< forall a. Floating a => a
pi                 = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Double
θ,Double
φ)
   | Bool
otherwise              = forall a b. CoArbitrary a => a -> Gen b -> Gen b
QC.coarbitrary (Int
1771964485166 :: Int)
instance QC.Function S² where
  function :: forall b. (S² -> b) -> S² :-> b
function = forall b a c.
Function b =>
(a -> b) -> (b -> a) -> (a -> c) -> a :-> c
QC.functionMap (\(S²Polar Double
θ Double
φ) -> (forall a. Floating a => a -> a
cos Double
φ, forall a. Floating a => a -> a
sin Double
φ)forall v s. (VectorSpace v, s ~ Scalar v) => v -> s -> v
^*forall a. Floating a => a -> a
tan (Double
θforall a. Fractional a => a -> a -> a
/Double
2))
                            (\(Double
x,Double
y) -> forall r. r -> r -> S²_ r
S²Polar (Double
2 forall a. Num a => a -> a -> a
* (forall a. Floating a => a -> a
atan forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Floating a => a -> a
sqrt forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Double
xforall a. Num a => a -> Int -> a
^Int
2 forall a. Num a => a -> a -> a
+ Double
yforall a. Num a => a -> Int -> a
^Int
2)) (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
pforall a. Ord a => a -> a -> Bool
>Int
9) forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (String
"S²Polar "forall a. [a] -> [a] -> [a]
++)
                           forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 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
. (Char
' 'forall a. a -> [a] -> [a]
:) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 Double
φ

instance QC.Arbitrary ℝP⁰ where
  arbitrary :: Gen ℝP⁰
arbitrary = forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure forall r. ℝP⁰_ r
ℝPZero

instance QC.Arbitrary ℝP¹ where
  arbitrary :: Gen ℝP¹
arbitrary = ( \Double
θ -> forall r. r -> ℝP¹_ r
HemisphereℝP¹Polar (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
2 forall a. Num a => a -> a -> a
- (Double
θforall a. Real a => a -> a -> a
`mod'`forall a. Floating a => a
pi)) ) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: ℝP¹ -> [ℝP¹]
shrink (HemisphereℝP¹Polar Double
θ) = forall r. r -> ℝP¹_ r
HemisphereℝP¹Polar forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. (forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
6forall a. Num a => a -> a -> a
*) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink (Double
θforall a. Num a => a -> a -> a
*Double
6forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi)

instance QC.Arbitrary ℝP² where
  arbitrary :: Gen ℝP²
arbitrary = ( \Double
θ Double
φ -> forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar (Double
θforall a. Real a => a -> a -> a
`mod'`forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
2) (forall a. Floating a => a
pi forall a. Num a => a -> a -> a
- (Double
φforall a. Real a => a -> a -> a
`mod'`(Double
2forall a. Num a => a -> a -> a
*forall a. Floating a => a
pi))) )
               forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitraryforall (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))
<*>forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: ℝP² -> [ℝP²]
shrink (HemisphereℝP²Polar Double
θ Double
φ) = [ forall r. r -> r -> ℝP²_ r
HemisphereℝP²Polar (Double
θ'forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
6) (Double
φ'forall a. Num a => a -> a -> a
*forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/Double
12)
                                    | Double
θ' <- forall a. Arbitrary a => a -> [a]
QC.shrink (Double
θforall a. Num a => a -> a -> a
*Double
6forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi)
                                    , Double
φ' <- forall a. Arbitrary a => a -> [a]
QC.shrink (Double
φforall a. Num a => a -> a -> a
*Double
12forall a. Fractional a => a -> a -> a
/forall a. Floating a => a
pi) ]

instance QC.Arbitrary D¹ where
  arbitrary :: Gen D¹
arbitrary = forall r. r -> D¹_ r
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
xforall a. Real a => a -> a -> a
`mod'`Double
2) forall a. Num a => a -> a -> a
- Double
1) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: D¹ -> [D¹]
shrink (D¹ Double
p) = forall r. r -> D¹_ r
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
xforall a. Real a => a -> a -> a
`mod'`Double
2) forall a. Num a => a -> a -> a
- Double
1) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink Double
p
instance QC.Arbitrary D² where
  arbitrary :: Gen D²
arbitrary = forall r. r -> r -> D²_ r
D²Polar 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
xforall a. Real a => a -> a -> a
`mod'`Double
1) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary
               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))
<*> (forall r. S¹_ r -> r
φParamS¹ forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary)
  shrink :: D² -> [D²]
shrink (D²Polar Double
r Double
φ) = forall r. r -> r -> D²_ r
D²Polar 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
xforall a. Real a => a -> a -> a
`mod'`Double
2) forall a. Num a => a -> a -> a
- Double
1) forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink Double
r
               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))
<*> (forall r. S¹_ r -> r
φParamS¹ forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
QC.shrink (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
pforall a. Ord a => a -> a -> Bool
>Int
9)
                forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (String
"FibreBundle "forall a. [a] -> [a] -> [a]
++) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. Show a => Int -> a -> ShowS
SP.showsPrec Int
10 m
m
                            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
' 'forall a. a -> [a] -> [a]
:) forall κ (k :: κ -> κ -> *) (a :: κ) (b :: κ) (c :: κ).
(Category k, Object k a, Object k b, Object k c) =>
k b c -> k a b -> k a c
. forall a. 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 = forall b f. b -> f -> FibreBundle b f
FibreBundle forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$> forall a. Arbitrary a => Gen a
QC.arbitrary 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))
<*> forall a. Arbitrary a => Gen a
QC.arbitrary
  shrink :: FibreBundle m f -> [FibreBundle m f]
shrink (FibreBundle m
m f
v) = [ forall b f. b -> f -> FibreBundle b f
FibreBundle m
m' f
v'
                             | m
m' <- forall a. Arbitrary a => a -> [a]
QC.shrink m
m
                             , f
v' <- forall a. Arbitrary a => a -> [a]
QC.shrink f
v ]


instance Binary (ZeroDim a) where
  put :: ZeroDim a -> Put
put ZeroDim a
Origin = forall (m :: * -> *) a. Monad m (->) => a -> m a
return ()
  get :: Get (ZeroDim a)
get = forall (m :: * -> *) a. Monad m (->) => a -> m a
return 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)