-- |
-- Module      : Data.Manifold.Atlas
-- Copyright   : (c) Justus Sagemüller 2015
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 

{-# LANGUAGE TypeFamilies              #-}
{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE UndecidableInstances      #-}
{-# LANGUAGE EmptyDataDecls, EmptyCase #-}
{-# LANGUAGE CPP                       #-}
{-# LANGUAGE ScopedTypeVariables       #-}

module Data.Manifold.Atlas where

import Prelude as Hask

import Data.VectorSpace
import Data.Manifold.PseudoAffine
import Data.Manifold.Types.Primitive
import Data.Manifold.WithBoundary
import Data.Manifold.WithBoundary.Class

import Data.Void

import Data.VectorSpace.Free
import Math.LinearMap.Category

import Control.Arrow

import Data.MemoTrie (HasTrie)

import qualified Linear.Affine as LinAff

class SemimanifoldWithBoundary m => Atlas m where
  type ChartIndex m :: *
  chartReferencePoint :: ChartIndex m -> m
  lookupAtlas :: m -> ChartIndex m

#define VectorSpaceAtlas(c,v)              \
instance (c) => Atlas (v) where {           \
  type ChartIndex (v) = ();                  \
  chartReferencePoint () = zeroV;              \
  lookupAtlas _ = () }

type NumPrime s = (Num' s, Eq s, OpenManifold s, ProjectableBoundary s)

VectorSpaceAtlas(NumPrime s, ZeroDim s)
VectorSpaceAtlas((), ℝ)
VectorSpaceAtlas(NumPrime s, V0 s)
VectorSpaceAtlas(NumPrime s, V1 s)
VectorSpaceAtlas(NumPrime s, V2 s)
VectorSpaceAtlas(NumPrime s, V3 s)
VectorSpaceAtlas(NumPrime s, V4 s)
VectorSpaceAtlas((NumPrime s, LinearSpace v, Scalar v ~ s, LinearSpace w, Scalar w ~ s), LinearMap s v w)
VectorSpaceAtlas((NumPrime s, LinearSpace v, Scalar v ~ s, LinearSpace w, Scalar w ~ s), Tensor s v w)

instance (Atlas x, Atlas y, SemimanifoldWithBoundary (x,y)) => Atlas (x,y) where
  type ChartIndex (x,y) = (ChartIndex x, ChartIndex y)
  chartReferencePoint :: ChartIndex (x, y) -> (x, y)
chartReferencePoint = forall m. Atlas m => ChartIndex m -> m
chartReferencePoint forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall m. Atlas m => ChartIndex m -> m
chartReferencePoint
  lookupAtlas :: (x, y) -> ChartIndex (x, y)
lookupAtlas = forall m. Atlas m => m -> ChartIndex m
lookupAtlas forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall m. Atlas m => m -> ChartIndex m
lookupAtlas

instance Atlas S⁰ where
  type ChartIndex S⁰ = S⁰
  chartReferencePoint :: ChartIndex S⁰ -> S⁰
chartReferencePoint = forall a. a -> a
id
  lookupAtlas :: S⁰ -> ChartIndex S⁰
lookupAtlas = forall a. a -> a
id
instance Atlas S¹ where
  type ChartIndex S¹ = S⁰
  chartReferencePoint :: ChartIndex S¹ -> S¹
chartReferencePoint S⁰
ChartIndex S¹
NegativeHalfSphere = 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
  chartReferencePoint S⁰
ChartIndex S¹
PositiveHalfSphere = 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
  lookupAtlas :: S¹ -> ChartIndex S¹
lookupAtlas (S¹Polar ℝ
φ) | ℝ
φforall a. Ord a => a -> a -> Bool
<ℝ
0        = forall r. S⁰_ r
NegativeHalfSphere
                     | Bool
otherwise  = forall r. S⁰_ r
PositiveHalfSphere
instance Atlas S² where
  type ChartIndex S² = S⁰
  chartReferencePoint :: ChartIndex S² -> S²
chartReferencePoint S⁰
ChartIndex S²
PositiveHalfSphere = forall r. r -> r -> S²_ r
S²Polar ℝ
0 ℝ
0
  chartReferencePoint S⁰
ChartIndex S²
NegativeHalfSphere = forall r. r -> r -> S²_ r
S²Polar forall a. Floating a => a
pi ℝ
0
  lookupAtlas :: S² -> ChartIndex S²
lookupAtlas (S²Polar ℝ
ϑ ℝ
_) | ℝ
ϑforall a. Ord a => a -> a -> Bool
<forall a. Floating a => a
piforall a. Fractional a => a -> a -> a
/ℝ
2     = forall r. S⁰_ r
PositiveHalfSphere
                            | Bool
otherwise  = forall r. S⁰_ r
NegativeHalfSphere

instance (Num'' n, LinearManifold (a n), Scalar (a n) ~ n, Needle (a n) ~ a n)
              => Atlas (LinAff.Point a n) where
  type ChartIndex (LinAff.Point a n) = ()
  chartReferencePoint :: ChartIndex (Point a n) -> Point a n
chartReferencePoint () = forall (f :: * -> *) a. f a -> Point f a
LinAff.P forall v. AdditiveGroup v => v
zeroV
  lookupAtlas :: Point a n -> ChartIndex (Point a n)
lookupAtlas Point a n
_ = ()

type Atlas' m = (Atlas m, HasTrie (ChartIndex m))


-- | The 'AffineSpace' class plus manifold constraints.
type AffineManifold m = ( Atlas' m, Manifold m, AffineSpace m
                        , Needle m ~ Diff m )

-- | An euclidean space is a real affine space whose tangent space is a Hilbert space.
type EuclidSpace x = ( AffineManifold x, InnerSpace (Diff x)
                     , DualVector (Diff x) ~ Diff x, Floating (Scalar (Diff x)) )

euclideanMetric :: EuclidSpace x => proxy x -> Metric x
euclideanMetric :: forall x (proxy :: * -> *). EuclidSpace x => proxy x -> Metric x
euclideanMetric proxy x
_ = forall v. HilbertSpace v => Norm v
euclideanNorm