{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver -fplugin=GHC.TypeLits.Normalise -fconstraint-solver-iterations=10 #-}
{-# LANGUAGE
    UndecidableInstances,
    StandaloneDeriving,
    GeneralizedNewtypeDeriving
    #-}
-- | The core mathematical definitions used by the rest of Goal. The central
-- object is a 'Point' on a 'Manifold'. A 'Manifold' is an object with a
-- 'Dimension', and a 'Point' represents an element of the 'Manifold' in a
-- particular coordinate system, represented by a chart.
module Goal.Geometry.Manifold
    ( -- * Manifolds
    Manifold (Dimension)
    , dimension
    -- ** Combinators
    , Replicated
    , R
    -- * Points
    , Point (Point,coordinates)
    , type (#)
    , breakPoint
    , listCoordinates
    , boxCoordinates
    -- ** Constructors
    , singleton
    , fromTuple
    , fromBoxed
    , Product (First,Second,split,join)
    -- ** Reshaping Points
    , splitReplicated
    , joinReplicated
    , joinBoxedReplicated
    , mapReplicated
    , mapReplicatedPoint
    , splitReplicatedProduct
    , joinReplicatedProduct
    -- * Euclidean Manifolds
    , Euclidean
    -- ** Charts
    , Cartesian
    , Polar
    -- ** Transition
    , Transition (transition)
    , transition2
    ) where


--- Imports ---


-- Goal --

import Goal.Core
import qualified Goal.Core.Vector.Generic as G
import qualified Goal.Core.Vector.Storable as S
import qualified Goal.Core.Vector.Boxed as B

-- Unqualified --

import Foreign.Storable
import Data.IndexedListLiterals
--import Control.Parallel.Strategies


--- Manifolds ---


-- | A geometric object with a certain 'Dimension'.
class KnownNat (Dimension x) => Manifold x where
    type Dimension x :: Nat

dimension0 :: Manifold x => Proxy (Dimension x) -> Proxy x -> Int
{-# INLINE dimension0 #-}
dimension0 :: Proxy (Dimension x) -> Proxy x -> Int
dimension0 Proxy (Dimension x)
prxy Proxy x
_ = Proxy (Dimension x) -> Int
forall (n :: Nat). KnownNat n => Proxy n -> Int
natValInt Proxy (Dimension x)
prxy

-- | The 'Dimension' of the given 'Manifold'.
dimension :: Manifold x => Proxy x -> Int
{-# INLINE dimension #-}
dimension :: Proxy x -> Int
dimension = Proxy (Dimension x) -> Proxy x -> Int
forall x. Manifold x => Proxy (Dimension x) -> Proxy x -> Int
dimension0 Proxy (Dimension x)
forall k (t :: k). Proxy t
Proxy


--- Points ---


-- | A 'Point' on a 'Manifold'. The phantom type @m@ represents the 'Manifold', and the phantom type
-- @c@ represents the coordinate system, or chart, in which the 'Point' is represented.
newtype Point c x =
    Point { Point c x -> Vector (Dimension x) Double
coordinates :: S.Vector (Dimension x) Double }
    deriving (Point c x -> Point c x -> Bool
(Point c x -> Point c x -> Bool)
-> (Point c x -> Point c x -> Bool) -> Eq (Point c x)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall c x. Point c x -> Point c x -> Bool
/= :: Point c x -> Point c x -> Bool
$c/= :: forall c x. Point c x -> Point c x -> Bool
== :: Point c x -> Point c x -> Bool
$c== :: forall c x. Point c x -> Point c x -> Bool
Eq,Eq (Point c x)
Eq (Point c x)
-> (Point c x -> Point c x -> Ordering)
-> (Point c x -> Point c x -> Bool)
-> (Point c x -> Point c x -> Bool)
-> (Point c x -> Point c x -> Bool)
-> (Point c x -> Point c x -> Bool)
-> (Point c x -> Point c x -> Point c x)
-> (Point c x -> Point c x -> Point c x)
-> Ord (Point c x)
Point c x -> Point c x -> Bool
Point c x -> Point c x -> Ordering
Point c x -> Point c x -> Point c x
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall c x. Eq (Point c x)
forall c x. Point c x -> Point c x -> Bool
forall c x. Point c x -> Point c x -> Ordering
forall c x. Point c x -> Point c x -> Point c x
min :: Point c x -> Point c x -> Point c x
$cmin :: forall c x. Point c x -> Point c x -> Point c x
max :: Point c x -> Point c x -> Point c x
$cmax :: forall c x. Point c x -> Point c x -> Point c x
>= :: Point c x -> Point c x -> Bool
$c>= :: forall c x. Point c x -> Point c x -> Bool
> :: Point c x -> Point c x -> Bool
$c> :: forall c x. Point c x -> Point c x -> Bool
<= :: Point c x -> Point c x -> Bool
$c<= :: forall c x. Point c x -> Point c x -> Bool
< :: Point c x -> Point c x -> Bool
$c< :: forall c x. Point c x -> Point c x -> Bool
compare :: Point c x -> Point c x -> Ordering
$ccompare :: forall c x. Point c x -> Point c x -> Ordering
$cp1Ord :: forall c x. Eq (Point c x)
Ord,Int -> Point c x -> ShowS
[Point c x] -> ShowS
Point c x -> String
(Int -> Point c x -> ShowS)
-> (Point c x -> String)
-> ([Point c x] -> ShowS)
-> Show (Point c x)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall c x. Int -> Point c x -> ShowS
forall c x. [Point c x] -> ShowS
forall c x. Point c x -> String
showList :: [Point c x] -> ShowS
$cshowList :: forall c x. [Point c x] -> ShowS
show :: Point c x -> String
$cshow :: forall c x. Point c x -> String
showsPrec :: Int -> Point c x -> ShowS
$cshowsPrec :: forall c x. Int -> Point c x -> ShowS
Show,Point c x -> ()
(Point c x -> ()) -> NFData (Point c x)
forall a. (a -> ()) -> NFData a
forall c x. Point c x -> ()
rnf :: Point c x -> ()
$crnf :: forall c x. Point c x -> ()
NFData)

deriving instance (KnownNat (Dimension x)) => Storable (Point c x)
deriving instance (Manifold x, KnownNat (Dimension x)) => Floating (Point c x)
deriving instance (Manifold x, KnownNat (Dimension x)) => Fractional (Point c x)

-- | An infix version of 'Point', where @x@ is assumed to be of type 'Double'.
type (c # x) = Point c x
infix 3 #

-- | Returns the coordinates of the point in list form.
listCoordinates :: c # x -> [Double]
{-# INLINE listCoordinates #-}
listCoordinates :: (c # x) -> [Double]
listCoordinates = Vector (Dimension x) Double -> [Double]
forall a (n :: Nat). Storable a => Vector n a -> [a]
S.toList (Vector (Dimension x) Double -> [Double])
-> ((c # x) -> Vector (Dimension x) Double) -> (c # x) -> [Double]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

-- | Returns the coordinates of the point as a boxed vector.
boxCoordinates :: c # x -> B.Vector (Dimension x) Double
{-# INLINE boxCoordinates #-}
boxCoordinates :: (c # x) -> Vector (Dimension x) Double
boxCoordinates =  Vector Vector (Dimension x) Double -> Vector (Dimension x) Double
forall (v :: Type -> Type) a (w :: Type -> Type) (n :: Nat).
(Vector v a, Vector w a) =>
Vector v n a -> Vector w n a
G.convert (Vector Vector (Dimension x) Double -> Vector (Dimension x) Double)
-> ((c # x) -> Vector Vector (Dimension x) Double)
-> (c # x)
-> Vector (Dimension x) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # x) -> Vector Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

-- | Constructs a point with coordinates given by a boxed vector.
fromBoxed :: B.Vector (Dimension x) Double -> c # x
{-# INLINE fromBoxed #-}
fromBoxed :: Vector (Dimension x) Double -> c # x
fromBoxed =  Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> (Vector (Dimension x) Double -> Vector (Dimension x) Double)
-> Vector (Dimension x) Double
-> c # x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Dimension x) Double -> Vector (Dimension x) Double
forall (v :: Type -> Type) a (w :: Type -> Type) (n :: Nat).
(Vector v a, Vector w a) =>
Vector v n a -> Vector w n a
G.convert

-- | Throws away the type-level information about the chart and manifold of the
-- given 'Point'.
breakPoint :: Dimension x ~ Dimension y => c # x -> Point d y
{-# INLINE breakPoint #-}
breakPoint :: (c # x) -> Point d y
breakPoint (Point Vector (Dimension x) Double
xs) = Vector (Dimension y) Double -> Point d y
forall c x. Vector (Dimension x) Double -> Point c x
Point Vector (Dimension x) Double
Vector (Dimension y) Double
xs

-- | Constructs a 'Point' with 'Dimension' 1.
singleton :: Dimension x ~ 1 => Double -> c # x
{-# INLINE singleton #-}
singleton :: Double -> c # x
singleton = Vector Vector 1 Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector 1 Double -> c # x)
-> (Double -> Vector Vector 1 Double) -> Double -> c # x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector Vector 1 Double
forall a. Storable a => a -> Vector 1 a
S.singleton

-- | Constructs a 'Point' from a tuple.
fromTuple
    :: ( IndexedListLiterals ds (Dimension x) Double, KnownNat (Dimension x) )
    => ds -> c # x
{-# INLINE fromTuple #-}
fromTuple :: ds -> c # x
fromTuple = Vector Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector (Dimension x) Double -> c # x)
-> (ds -> Vector Vector (Dimension x) Double) -> ds -> c # x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ds -> Vector Vector (Dimension x) Double
forall a input (length :: Nat).
(Storable a, IndexedListLiterals input length a,
 KnownNat length) =>
input -> Vector length a
S.fromTuple


-- Manifold Combinators --

-- | A 'Product' 'Manifold' is one that is produced out of the
-- sum/product/concatenation of two source 'Manifold's.
class ( Manifold (First z), Manifold (Second z), Manifold z
      , Dimension z ~ (Dimension (First z) + Dimension (Second z)) )
      => Product z where
    -- | The 'First' 'Manifold'.
    type First z :: Type
    -- | The 'Second 'Manifold'.
    type Second z :: Type
    -- | Combine 'Point's from the 'First' and 'Second' 'Manifold' into a
    -- 'Point' on the 'Product' 'Manifold'.
    join :: c # First z -> c # Second z -> c # z
    -- | Split a 'Point' on the 'Product' 'Manifold' into 'Point's from the
    -- 'First' and 'Second' 'Manifold'.
    split :: c # z -> (c # First z, c # Second z)

-- | A Sum type for repetitions of the same 'Manifold'.
data Replicated (k :: Nat) m

-- | An abbreviation for 'Replicated'.
type R k x = Replicated k x

-- | Splits a 'Point' on a 'Replicated' 'Manifold' into a Vector of of 'Point's.
splitReplicated
    :: (KnownNat k, Manifold x)
    => c # Replicated k x
    -> S.Vector k (c # x)
{-# INLINE splitReplicated #-}
splitReplicated :: (c # Replicated k x) -> Vector k (c # x)
splitReplicated = (Vector (Dimension x) Double -> c # x)
-> Vector k (Vector (Dimension x) Double) -> Vector k (c # x)
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector k (Vector (Dimension x) Double) -> Vector k (c # x))
-> ((c # Replicated k x) -> Vector k (Vector (Dimension x) Double))
-> (c # Replicated k x)
-> Vector k (c # x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (k * Dimension x) Double
-> Vector k (Vector (Dimension x) Double)
forall (n :: Nat) (k :: Nat) a.
(KnownNat n, KnownNat k, Storable a) =>
Vector (n * k) a -> Vector n (Vector k a)
S.breakEvery (Vector (k * Dimension x) Double
 -> Vector k (Vector (Dimension x) Double))
-> ((c # Replicated k x) -> Vector (k * Dimension x) Double)
-> (c # Replicated k x)
-> Vector k (Vector (Dimension x) Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # Replicated k x) -> Vector (k * Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates

-- | Joins a Vector of of 'Point's into a 'Point' on a 'Replicated' 'Manifold'.
joinReplicated
    :: (KnownNat k, Manifold x)
    => S.Vector k (c # x)
    -> c # Replicated k x
{-# INLINE joinReplicated #-}
joinReplicated :: Vector k (c # x) -> c # Replicated k x
joinReplicated Vector k (c # x)
ps = Vector (Dimension (Replicated k x)) Double -> c # Replicated k x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension (Replicated k x)) Double -> c # Replicated k x)
-> Vector (Dimension (Replicated k x)) Double -> c # Replicated k x
forall a b. (a -> b) -> a -> b
$ ((c # x) -> Vector (Dimension x) Double)
-> Vector k (c # x) -> Vector (k * Dimension x) Double
forall a b (m :: Nat) (n :: Nat).
(Storable a, Storable b) =>
(a -> Vector m b) -> Vector n a -> Vector (n * m) b
S.concatMap (c # x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Vector k (c # x)
ps

-- | Joins a Vector of of 'Point's into a 'Point' on a 'Replicated' 'Manifold'.
joinBoxedReplicated
    :: (KnownNat k, Manifold x)
    => B.Vector k (c # x)
    -> c # Replicated k x
{-# INLINE joinBoxedReplicated #-}
joinBoxedReplicated :: Vector k (c # x) -> c # Replicated k x
joinBoxedReplicated Vector k (c # x)
ps = Vector Vector (k * Dimension x) Double -> c # Replicated k x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector (k * Dimension x) Double -> c # Replicated k x)
-> (Vector k (c # x) -> Vector Vector (k * Dimension x) Double)
-> Vector k (c # x)
-> c # Replicated k x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c # x) -> Vector (Dimension x) Double)
-> Vector k (c # x) -> Vector Vector (k * Dimension x) Double
forall a b (m :: Nat) (n :: Nat).
(Storable a, Storable b) =>
(a -> Vector m b) -> Vector n a -> Vector (n * m) b
S.concatMap (c # x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates (Vector k (c # x) -> c # Replicated k x)
-> Vector k (c # x) -> c # Replicated k x
forall a b. (a -> b) -> a -> b
$ Vector k (c # x) -> Vector k (c # x)
forall (v :: Type -> Type) a (w :: Type -> Type) (n :: Nat).
(Vector v a, Vector w a) =>
Vector v n a -> Vector w n a
G.convert Vector k (c # x)
ps

-- | A combination of 'splitReplicated' and 'fmap'.
mapReplicated
    :: (Storable a, KnownNat k, Manifold x)
    => (c # x -> a) -> c # Replicated k x -> S.Vector k a
{-# INLINE mapReplicated #-}
mapReplicated :: ((c # x) -> a) -> (c # Replicated k x) -> Vector k a
mapReplicated (c # x) -> a
f c # Replicated k x
rp = (c # x) -> a
f ((c # x) -> a) -> Vector k (c # x) -> Vector k a
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
`S.map` (c # Replicated k x) -> Vector k (c # x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated k x
rp

-- | A combination of 'splitReplicated' and 'fmap', where the value of the mapped function is also a point.
mapReplicatedPoint
    :: (KnownNat k, Manifold x, Manifold y)
    => (c # x -> Point d y) -> c # Replicated k x -> Point d (Replicated k y)
{-# INLINE mapReplicatedPoint #-}
mapReplicatedPoint :: ((c # x) -> Point d y)
-> (c # Replicated k x) -> Point d (Replicated k y)
mapReplicatedPoint (c # x) -> Point d y
f c # Replicated k x
rp = Vector Vector (k * Dimension y) Double -> Point d (Replicated k y)
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector Vector (k * Dimension y) Double
 -> Point d (Replicated k y))
-> (Vector k (c # x) -> Vector Vector (k * Dimension y) Double)
-> Vector k (c # x)
-> Point d (Replicated k y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c # x) -> Vector (Dimension y) Double)
-> Vector k (c # x) -> Vector Vector (k * Dimension y) Double
forall a b (m :: Nat) (n :: Nat).
(Storable a, Storable b) =>
(a -> Vector m b) -> Vector n a -> Vector (n * m) b
S.concatMap (Point d y -> Vector (Dimension y) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates (Point d y -> Vector (Dimension y) Double)
-> ((c # x) -> Point d y) -> (c # x) -> Vector (Dimension y) Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # x) -> Point d y
f) (Vector k (c # x) -> Point d (Replicated k y))
-> Vector k (c # x) -> Point d (Replicated k y)
forall a b. (a -> b) -> a -> b
$ (c # Replicated k x) -> Vector k (c # x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated k x
rp

-- | Splits a 'Replicated' 'Product' 'Manifold' into a pair of 'Replicated' 'Manifold's.
splitReplicatedProduct
    :: (KnownNat k, Product x)
    => c # Replicated k x
    -> (c # Replicated k (First x), c # Replicated k (Second x))
{-# INLINE splitReplicatedProduct #-}
splitReplicatedProduct :: (c # Replicated k x)
-> (c # Replicated k (First x), c # Replicated k (Second x))
splitReplicatedProduct c # Replicated k x
xys =
    let (Vector k (c # First x)
xs,Vector k (c # Second x)
ys) = Vector k (c # First x, c # Second x)
-> (Vector k (c # First x), Vector k (c # Second x))
forall (n :: Nat) a b. Vector n (a, b) -> (Vector n a, Vector n b)
B.unzip (Vector k (c # First x, c # Second x)
 -> (Vector k (c # First x), Vector k (c # Second x)))
-> (Vector Vector k (c # x)
    -> Vector k (c # First x, c # Second x))
-> Vector Vector k (c # x)
-> (Vector k (c # First x), Vector k (c # Second x))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((c # x) -> (c # First x, c # Second x))
-> Vector k (c # x) -> Vector k (c # First x, c # Second x)
forall a b (n :: Nat). (a -> b) -> Vector n a -> Vector n b
B.map (c # x) -> (c # First x, c # Second x)
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split (Vector k (c # x) -> Vector k (c # First x, c # Second x))
-> (Vector Vector k (c # x) -> Vector k (c # x))
-> Vector Vector k (c # x)
-> Vector k (c # First x, c # Second x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Vector k (c # x) -> Vector k (c # x)
forall (v :: Type -> Type) a (w :: Type -> Type) (n :: Nat).
(Vector v a, Vector w a) =>
Vector v n a -> Vector w n a
G.convert (Vector Vector k (c # x)
 -> (Vector k (c # First x), Vector k (c # Second x)))
-> Vector Vector k (c # x)
-> (Vector k (c # First x), Vector k (c # Second x))
forall a b. (a -> b) -> a -> b
$ (c # Replicated k x) -> Vector Vector k (c # x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated k x
xys
     in (Vector k (c # First x) -> c # Replicated k (First x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
Vector k (c # x) -> c # Replicated k x
joinBoxedReplicated Vector k (c # First x)
xs, Vector k (c # Second x) -> c # Replicated k (Second x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
Vector k (c # x) -> c # Replicated k x
joinBoxedReplicated Vector k (c # Second x)
ys)

-- | joins a 'Replicated' 'Product' 'Manifold' out of a pair of 'Replicated' 'Manifold's.
joinReplicatedProduct
    :: (KnownNat k, Product x)
    => c # Replicated k (First x)
    -> c # Replicated k (Second x)
    -> c # Replicated k x
{-# INLINE joinReplicatedProduct #-}
joinReplicatedProduct :: (c # Replicated k (First x))
-> (c # Replicated k (Second x)) -> c # Replicated k x
joinReplicatedProduct c # Replicated k (First x)
xs0 c # Replicated k (Second x)
ys0 =
    let xs :: Vector k (c # First x)
xs = (c # Replicated k (First x)) -> Vector k (c # First x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated k (First x)
xs0
        ys :: Vector k (c # Second x)
ys = (c # Replicated k (Second x)) -> Vector k (c # Second x)
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
(c # Replicated k x) -> Vector k (c # x)
splitReplicated c # Replicated k (Second x)
ys0
    in Vector k (c # x) -> c # Replicated k x
forall (k :: Nat) x c.
(KnownNat k, Manifold x) =>
Vector k (c # x) -> c # Replicated k x
joinReplicated (Vector k (c # x) -> c # Replicated k x)
-> Vector k (c # x) -> c # Replicated k x
forall a b. (a -> b) -> a -> b
$ ((c # First x) -> (c # Second x) -> c # x)
-> Vector k (c # First x)
-> Vector k (c # Second x)
-> Vector k (c # x)
forall a b c (n :: Nat).
(Storable a, Storable b, Storable c) =>
(a -> b -> c) -> Vector n a -> Vector n b -> Vector n c
S.zipWith (c # First x) -> (c # Second x) -> c # x
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join Vector k (c # First x)
xs Vector k (c # Second x)
ys

-- Charts on Euclidean Space --

-- | @n@-dimensional Euclidean space.
data Euclidean (n :: Nat)

-- | 'Cartesian' coordinates on 'Euclidean' space.
data Cartesian

-- | 'Polar' coordinates on 'Euclidean' space.
data Polar

-- | A 'transition' involves taking a point represented by the chart c,
-- and re-representing in terms of the chart d.
class Transition c d x where
    transition :: c # x -> d # x

-- | Generalizes a function of two points in given coordinate systems to a
-- function on arbitrary coordinate systems.
transition2
    :: (Transition cx dx x, Transition cy dy y)
    => (dx # x -> dy # y -> a)
    -> cx # x
    -> cy # y
    -> a
{-# INLINE transition2 #-}
transition2 :: ((dx # x) -> (dy # y) -> a) -> (cx # x) -> (cy # y) -> a
transition2 (dx # x) -> (dy # y) -> a
f cx # x
p cy # y
q =
   (dx # x) -> (dy # y) -> a
f ((cx # x) -> dx # x
forall c d x. Transition c d x => (c # x) -> d # x
transition cx # x
p) ((cy # y) -> dy # y
forall c d x. Transition c d x => (c # x) -> d # x
transition cy # y
q)


--- Instances ---


-- Transition --


-- Combinators --

instance Manifold x => Manifold [x] where
    -- | The list 'Manifold' represents identical copies of the given 'Manifold'.
    type Dimension [x] = Dimension x

instance (Manifold x, Manifold y) => Manifold (x,y) where
    type Dimension (x,y) = Dimension x + Dimension y

instance (KnownNat k, Manifold x) => Manifold (Replicated k x) where
    type Dimension (Replicated k x) = k * Dimension x

instance (Manifold x, Manifold y) => Product (x,y) where
    type First (x,y) = x
    type Second (x,y) = y
    {-# INLINE split #-}
    split :: (c # (x, y)) -> (c # First (x, y), c # Second (x, y))
split (Point Vector (Dimension (x, y)) Double
xs) =
        let (Vector (Dimension x) Double
xms,Vector (Dimension y) Double
xns) = Vector (Dimension x + Dimension y) Double
-> (Vector (Dimension x) Double, Vector (Dimension y) Double)
forall (n :: Nat) (m :: Nat) a.
(KnownNat n, Storable a) =>
Vector (n + m) a -> (Vector n a, Vector m a)
S.splitAt Vector (Dimension x + Dimension y) Double
Vector (Dimension (x, y)) Double
xs
         in (Vector (Dimension x) Double -> Point c x
forall c x. Vector (Dimension x) Double -> Point c x
Point Vector (Dimension x) Double
xms, Vector (Dimension y) Double -> Point c y
forall c x. Vector (Dimension x) Double -> Point c x
Point Vector (Dimension y) Double
xns)
    {-# INLINE join #-}
    join :: (c # First (x, y)) -> (c # Second (x, y)) -> c # (x, y)
join (Point Vector (Dimension (First (x, y))) Double
xms) (Point Vector (Dimension (Second (x, y))) Double
xns) =
        Vector (Dimension (x, y)) Double -> c # (x, y)
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension (x, y)) Double -> c # (x, y))
-> Vector (Dimension (x, y)) Double -> c # (x, y)
forall a b. (a -> b) -> a -> b
$ Vector (Dimension x) Double
Vector (Dimension (First (x, y))) Double
xms Vector (Dimension x) Double
-> Vector (Dimension y) Double
-> Vector (Dimension x + Dimension y) Double
forall (n :: Nat) (m :: Nat) a.
Storable a =>
Vector n a -> Vector m a -> Vector (n + m) a
S.++ Vector (Dimension y) Double
Vector (Dimension (Second (x, y))) Double
xns


-- Euclidean Space --

instance (KnownNat k) => Manifold (Euclidean k) where
    type Dimension (Euclidean k) = k

instance Transition Polar Cartesian (Euclidean 2) where
    {-# INLINE transition #-}
    transition :: (Polar # Euclidean 2) -> Cartesian # Euclidean 2
transition Polar # Euclidean 2
rphi =
        let [Double
r,Double
phi] = (Polar # Euclidean 2) -> [Double]
forall c x. (c # x) -> [Double]
listCoordinates Polar # Euclidean 2
rphi
            x :: Double
x = Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
cos Double
phi
            y :: Double
y = Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
forall a. Floating a => a -> a
sin Double
phi
         in (Double, Double) -> Cartesian # Euclidean 2
forall ds x c.
(IndexedListLiterals ds (Dimension x) Double,
 KnownNat (Dimension x)) =>
ds -> c # x
fromTuple (Double
x,Double
y)

instance Transition Cartesian Polar (Euclidean 2) where
    {-# INLINE transition #-}
    transition :: (Cartesian # Euclidean 2) -> Polar # Euclidean 2
transition Cartesian # Euclidean 2
xy =
        let [Double
x,Double
y] = (Cartesian # Euclidean 2) -> [Double]
forall c x. (c # x) -> [Double]
listCoordinates Cartesian # Euclidean 2
xy
            r :: Double
r = Double -> Double
forall a. Floating a => a -> a
sqrt (Double -> Double) -> Double -> Double
forall a b. (a -> b) -> a -> b
$ (Double
xDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
x) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
yDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
y)
            phi :: Double
phi = Double -> Double -> Double
forall a. RealFloat a => a -> a -> a
atan2 Double
y Double
x
         in (Double, Double) -> Polar # Euclidean 2
forall ds x c.
(IndexedListLiterals ds (Dimension x) Double,
 KnownNat (Dimension x)) =>
ds -> c # x
fromTuple (Double
r,Double
phi)


--- Transitions ---


instance (Manifold x, Manifold y, Transition c d x, Transition c d y)
  => Transition c d (x,y) where
    {-# INLINE transition #-}
    transition :: (c # (x, y)) -> d # (x, y)
transition c # (x, y)
cxy =
        let (c # x
cx,c # y
cy) = (c # (x, y)) -> (c # First (x, y), c # Second (x, y))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # (x, y)
cxy
         in (d # First (x, y)) -> (d # Second (x, y)) -> d # (x, y)
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join ((c # x) -> d # x
forall c d x. Transition c d x => (c # x) -> d # x
transition c # x
cx) ((c # y) -> d # y
forall c d x. Transition c d x => (c # x) -> d # x
transition c # y
cy)

instance (KnownNat k, Manifold x, Transition c d x) => Transition c d (Replicated k x) where
    {-# INLINE transition #-}
    transition :: (c # Replicated k x) -> d # Replicated k x
transition = ((c # x) -> Point d x)
-> (c # Replicated k x) -> d # Replicated k x
forall (k :: Nat) x y c d.
(KnownNat k, Manifold x, Manifold y) =>
((c # x) -> Point d y)
-> (c # Replicated k x) -> Point d (Replicated k y)
mapReplicatedPoint (c # x) -> Point d x
forall c d x. Transition c d x => (c # x) -> d # x
transition


--- Numeric Classes ---


instance (Manifold x, KnownNat (Dimension x)) => Num (c # x) where
    {-# INLINE (+) #-}
    + :: (c # x) -> (c # x) -> c # x
(+) (Point Vector (Dimension x) Double
xs) (Point Vector (Dimension x) Double
xs') = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension x) Double -> c # x
forall a b. (a -> b) -> a -> b
$ Vector (Dimension x) Double
-> Vector (Dimension x) Double -> Vector (Dimension x) Double
forall x (n :: Nat).
Numeric x =>
Vector n x -> Vector n x -> Vector n x
S.add Vector (Dimension x) Double
xs Vector (Dimension x) Double
xs'
    {-# INLINE (*) #-}
    * :: (c # x) -> (c # x) -> c # x
(*) (Point Vector (Dimension x) Double
xs) (Point Vector (Dimension x) Double
xs') = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension x) Double -> c # x
forall a b. (a -> b) -> a -> b
$ Vector (Dimension x) Double
xs Vector (Dimension x) Double
-> Vector (Dimension x) Double -> Vector (Dimension x) Double
forall a. Num a => a -> a -> a
* Vector (Dimension x) Double
xs'
    {-# INLINE negate #-}
    negate :: (c # x) -> c # x
negate (Point Vector (Dimension x) Double
xs) = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension x) Double -> c # x
forall a b. (a -> b) -> a -> b
$ Double
-> Vector (Dimension x) Double -> Vector (Dimension x) Double
forall x (n :: Nat). Numeric x => x -> Vector n x -> Vector n x
S.scale (-Double
1) Vector (Dimension x) Double
xs
    {-# INLINE abs #-}
    abs :: (c # x) -> c # x
abs (Point Vector (Dimension x) Double
xs) = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension x) Double -> c # x
forall a b. (a -> b) -> a -> b
$ Vector (Dimension x) Double -> Vector (Dimension x) Double
forall a. Num a => a -> a
abs Vector (Dimension x) Double
xs
    {-# INLINE signum #-}
    signum :: (c # x) -> c # x
signum (Point Vector (Dimension x) Double
xs) = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension x) Double -> c # x
forall a b. (a -> b) -> a -> b
$ Vector (Dimension x) Double -> Vector (Dimension x) Double
forall a. Num a => a -> a
signum Vector (Dimension x) Double
xs
    {-# INLINE fromInteger #-}
    fromInteger :: Integer -> c # x
fromInteger Integer
x = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> (Double -> Vector (Dimension x) Double) -> Double -> c # x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Vector (Dimension x) Double
forall (n :: Nat) a. (KnownNat n, Storable a) => a -> Vector n a
S.replicate (Double -> c # x) -> Double -> c # x
forall a b. (a -> b) -> a -> b
$ Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
x