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

{-# LANGUAGE FlexibleInstances        #-}
{-# LANGUAGE UndecidableInstances     #-}
{-# LANGUAGE TypeFamilies             #-}
{-# LANGUAGE FunctionalDependencies   #-}
{-# LANGUAGE FlexibleContexts         #-}
{-# LANGUAGE LiberalTypeSynonyms      #-}
{-# LANGUAGE GADTs                    #-}
{-# LANGUAGE RankNTypes               #-}
{-# LANGUAGE TupleSections            #-}
{-# LANGUAGE ConstraintKinds          #-}
{-# LANGUAGE PatternGuards            #-}
{-# LANGUAGE PatternSynonyms          #-}
{-# LANGUAGE ViewPatterns             #-}
{-# LANGUAGE TypeOperators            #-}
{-# LANGUAGE TypeApplications         #-}
{-# LANGUAGE UnicodeSyntax            #-}
{-# LANGUAGE MultiWayIf               #-}
{-# LANGUAGE ScopedTypeVariables      #-}
{-# LANGUAGE RecordWildCards          #-}
{-# LANGUAGE CPP                      #-}


module Data.Function.Affine (
              Affine(..)
            , evalAffine
            , fromOffsetSlope
            -- * Misc
            , lensEmbedding, correspondingDirections
            ) where
    


import Data.Semigroup

import Data.MemoTrie
import Data.VectorSpace
import Data.AffineSpace
import Data.Tagged
import Data.Manifold.Types.Primitive
import Data.Manifold.PseudoAffine
import Data.Manifold.WithBoundary
import Data.Manifold.Atlas
import Data.Embedding

import qualified Prelude
import qualified Control.Applicative as Hask
import Data.Functor (($>))

import Control.Category.Constrained.Prelude hiding ((^))
import Control.Category.Constrained.Reified
import Control.Arrow.Constrained
import Control.Monad.Constrained
import Data.Foldable.Constrained

import Math.LinearMap.Category

import Control.Lens



data Affine s d c where
    Affine :: (ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
               -> Affine s d c

instance Category (Affine s) where
  type Object (Affine s) x = ( Manifold x
                             , Atlas' x
                             , Scalar (Needle x) ~ s )
  id :: Affine s a a
id = (ChartIndex a :->: (a, LinearMap s (Needle a) (Needle a)))
-> Affine s a a
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex a :->: (a, LinearMap s (Needle a) (Needle a)))
 -> Affine s a a)
-> ((ChartIndex a -> (a, LinearMap s (Needle a) (Needle a)))
    -> ChartIndex a :->: (a, LinearMap s (Needle a) (Needle a)))
-> (ChartIndex a -> (a, LinearMap s (Needle a) (Needle a)))
-> Affine s 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
. (ChartIndex a -> (a, LinearMap s (Needle a) (Needle a)))
-> ChartIndex a :->: (a, LinearMap s (Needle a) (Needle a))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex a -> (a, LinearMap s (Needle a) (Needle a)))
 -> Affine s a a)
-> (ChartIndex a -> (a, LinearMap s (Needle a) (Needle a)))
-> Affine s a a
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ChartIndex a -> a
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint (ChartIndex a -> a)
-> (a -> (a, LinearMap s (Needle a) (Needle a)))
-> ChartIndex a
-> (a, LinearMap s (Needle a) (Needle a))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> a -> a
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id (a -> a)
-> (a -> LinearMap s (Needle a) (Needle a))
-> a
-> (a, LinearMap s (Needle a) (Needle a))
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& LinearMap s (Needle a) (Needle a)
-> a -> LinearMap s (Needle a) (Needle a)
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const LinearMap s (Needle a) (Needle a)
forall κ (k :: κ -> κ -> *) (a :: κ).
(Category k, Object k a) =>
k a a
id
  Affine ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c))
f . :: Affine s b c -> Affine s a b -> Affine s a c
. Affine ChartIndex a :->: (b, LinearMap s (Needle a) (Needle b))
g = (ChartIndex a :->: (c, LinearMap s (Needle a) (Needle c)))
-> Affine s a c
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex a :->: (c, LinearMap s (Needle a) (Needle c)))
 -> Affine s a c)
-> ((ChartIndex a -> (c, LinearMap s (Needle a) (Needle c)))
    -> ChartIndex a :->: (c, LinearMap s (Needle a) (Needle c)))
-> (ChartIndex a -> (c, LinearMap s (Needle a) (Needle c)))
-> Affine s a c
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
. (ChartIndex a -> (c, LinearMap s (Needle a) (Needle c)))
-> ChartIndex a :->: (c, LinearMap s (Needle a) (Needle c))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie
      ((ChartIndex a -> (c, LinearMap s (Needle a) (Needle c)))
 -> Affine s a c)
-> (ChartIndex a -> (c, LinearMap s (Needle a) (Needle c)))
-> Affine s a c
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ChartIndex a
ixa -> case (ChartIndex a :->: (b, LinearMap s (Needle a) (Needle b)))
-> ChartIndex a -> (b, LinearMap s (Needle a) (Needle b))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex a :->: (b, LinearMap s (Needle a) (Needle b))
g ChartIndex a
ixa of
           (b
b, LinearMap s (Needle a) (Needle b)
ða'b) -> case (ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c)))
-> ChartIndex b -> (c, LinearMap s (Needle b) (Needle c))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c))
f (ChartIndex b -> (c, LinearMap s (Needle b) (Needle c)))
-> ChartIndex b -> (c, LinearMap s (Needle b) (Needle c))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ b -> ChartIndex b
forall m. Atlas m => m -> ChartIndex m
lookupAtlas b
b of
            (c
c, LinearMap s (Needle b) (Needle c)
ðb'c) -> (c
c, LinearMap s (Needle b) (Needle c)
ðb'c LinearMap s (Needle b) (Needle c)
-> LinearMap s (Needle a) (Needle b)
-> LinearMap s (Needle a) (Needle c)
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
. LinearMap s (Needle a) (Needle b)
ða'b)

instance ∀ s . (ScalarManifold s, Eq s) => Cartesian (Affine s) where
  type UnitObject (Affine s) = ZeroDim s
  swap :: Affine s (a, b) (b, a)
swap = ((ChartIndex a, ChartIndex b)
 :->: ((b, a),
       LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
-> Affine s (a, b) (b, a)
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine (((ChartIndex a, ChartIndex b)
  :->: ((b, a),
        LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
 -> Affine s (a, b) (b, a))
-> (((ChartIndex a, ChartIndex b)
     -> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
    -> (ChartIndex a, ChartIndex b)
       :->: ((b, a),
             LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
-> ((ChartIndex a, ChartIndex b)
    -> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
-> Affine s (a, b) (b, 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
. ((ChartIndex a, ChartIndex b)
 -> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
-> (ChartIndex a, ChartIndex b)
   :->: ((b, a),
         LinearMap s (Needle a, Needle b) (Needle b, Needle a))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie (((ChartIndex a, ChartIndex b)
  -> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
 -> Affine s (a, b) (b, a))
-> ((ChartIndex a, ChartIndex b)
    -> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
-> Affine s (a, b) (b, a)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ChartIndex a, ChartIndex b) -> (a, b)
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint ((ChartIndex a, ChartIndex b) -> (a, b))
-> ((a, b)
    -> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a)))
-> (ChartIndex a, ChartIndex b)
-> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (a, b) -> (b, a)
forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap ((a, b) -> (b, a))
-> ((a, b)
    -> LinearMap s (Needle a, Needle b) (Needle b, Needle a))
-> (a, b)
-> ((b, a), LinearMap s (Needle a, Needle b) (Needle b, Needle a))
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& LinearMap s (Needle a, Needle b) (Needle b, Needle a)
-> (a, b) -> LinearMap s (Needle a, Needle b) (Needle b, Needle a)
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const LinearMap s (Needle a, Needle b) (Needle b, Needle a)
forall (k :: * -> * -> *) a b.
(Cartesian k, ObjectPair k a b, ObjectPair k b a) =>
k (a, b) (b, a)
swap
  attachUnit :: Affine s a (a, unit)
attachUnit = (ChartIndex a
 :->: ((a, ZeroDim s),
       LinearMap s (Needle a) (Needle a, ZeroDim s)))
-> Affine s a (a, unit)
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex a
  :->: ((a, ZeroDim s),
        LinearMap s (Needle a) (Needle a, ZeroDim s)))
 -> Affine s a (a, unit))
-> ((ChartIndex a
     -> ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s)))
    -> ChartIndex a
       :->: ((a, ZeroDim s),
             LinearMap s (Needle a) (Needle a, ZeroDim s)))
-> (ChartIndex a
    -> ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s)))
-> Affine s a (a, unit)
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
. (ChartIndex a
 -> ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s)))
-> ChartIndex a
   :->: ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex a
  -> ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s)))
 -> Affine s a (a, unit))
-> (ChartIndex a
    -> ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s)))
-> Affine s a (a, unit)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ChartIndex a -> a
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint (ChartIndex a -> a)
-> (a
    -> ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s)))
-> ChartIndex a
-> ((a, ZeroDim s), LinearMap s (Needle a) (Needle a, ZeroDim s))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \a
a -> ((a
a,ZeroDim s
forall s. ZeroDim s
Origin), LinearMap s (Needle a) (Needle a, ZeroDim s)
forall (k :: * -> * -> *) unit a.
(Cartesian k, unit ~ UnitObject k, ObjectPair k a unit) =>
k a (a, unit)
attachUnit)
  detachUnit :: Affine s (a, unit) a
detachUnit = ((ChartIndex a, ())
 :->: (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
-> Affine s (a, unit) a
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine (((ChartIndex a, ())
  :->: (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
 -> Affine s (a, unit) a)
-> (((ChartIndex a, ())
     -> (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
    -> (ChartIndex a, ())
       :->: (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
-> ((ChartIndex a, ())
    -> (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
-> Affine s (a, unit) 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
. ((ChartIndex a, ())
 -> (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
-> (ChartIndex a, ())
   :->: (a, LinearMap s (Needle a, ZeroDim s) (Needle a))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie (((ChartIndex a, ())
  -> (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
 -> Affine s (a, unit) a)
-> ((ChartIndex a, ())
    -> (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
-> Affine s (a, unit) a
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ChartIndex a, ()) -> (a, ZeroDim s)
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint
                 ((ChartIndex a, ()) -> (a, ZeroDim s))
-> ((a, ZeroDim s)
    -> (a, LinearMap s (Needle a, ZeroDim s) (Needle a)))
-> (ChartIndex a, ())
-> (a, LinearMap s (Needle a, ZeroDim s) (Needle a))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \(a
a,ZeroDim s
Origin::ZeroDim s) -> (a
a, LinearMap s (Needle a, ZeroDim s) (Needle a)
forall (k :: * -> * -> *) unit a.
(Cartesian k, unit ~ UnitObject k, ObjectPair k a unit) =>
k (a, unit) a
detachUnit)
  regroup :: Affine s (a, (b, c)) ((a, b), c)
regroup = ((ChartIndex a, (ChartIndex b, ChartIndex c))
 :->: (((a, b), c),
       LinearMap
         s
         (Needle a, (Needle b, Needle c))
         ((Needle a, Needle b), Needle c)))
-> Affine s (a, (b, c)) ((a, b), c)
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine (((ChartIndex a, (ChartIndex b, ChartIndex c))
  :->: (((a, b), c),
        LinearMap
          s
          (Needle a, (Needle b, Needle c))
          ((Needle a, Needle b), Needle c)))
 -> Affine s (a, (b, c)) ((a, b), c))
-> (((ChartIndex a, (ChartIndex b, ChartIndex c))
     -> (((a, b), c),
         LinearMap
           s
           (Needle a, (Needle b, Needle c))
           ((Needle a, Needle b), Needle c)))
    -> (ChartIndex a, (ChartIndex b, ChartIndex c))
       :->: (((a, b), c),
             LinearMap
               s
               (Needle a, (Needle b, Needle c))
               ((Needle a, Needle b), Needle c)))
-> ((ChartIndex a, (ChartIndex b, ChartIndex c))
    -> (((a, b), c),
        LinearMap
          s
          (Needle a, (Needle b, Needle c))
          ((Needle a, Needle b), Needle c)))
-> Affine s (a, (b, c)) ((a, b), c)
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
. ((ChartIndex a, (ChartIndex b, ChartIndex c))
 -> (((a, b), c),
     LinearMap
       s
       (Needle a, (Needle b, Needle c))
       ((Needle a, Needle b), Needle c)))
-> (ChartIndex a, (ChartIndex b, ChartIndex c))
   :->: (((a, b), c),
         LinearMap
           s
           (Needle a, (Needle b, Needle c))
           ((Needle a, Needle b), Needle c))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie (((ChartIndex a, (ChartIndex b, ChartIndex c))
  -> (((a, b), c),
      LinearMap
        s
        (Needle a, (Needle b, Needle c))
        ((Needle a, Needle b), Needle c)))
 -> Affine s (a, (b, c)) ((a, b), c))
-> ((ChartIndex a, (ChartIndex b, ChartIndex c))
    -> (((a, b), c),
        LinearMap
          s
          (Needle a, (Needle b, Needle c))
          ((Needle a, Needle b), Needle c)))
-> Affine s (a, (b, c)) ((a, b), c)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ChartIndex a, (ChartIndex b, ChartIndex c)) -> (a, (b, c))
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint ((ChartIndex a, (ChartIndex b, ChartIndex c)) -> (a, (b, c)))
-> ((a, (b, c))
    -> (((a, b), c),
        LinearMap
          s
          (Needle a, (Needle b, Needle c))
          ((Needle a, Needle b), Needle c)))
-> (ChartIndex a, (ChartIndex b, ChartIndex c))
-> (((a, b), c),
    LinearMap
      s
      (Needle a, (Needle b, Needle c))
      ((Needle a, Needle b), Needle c))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (a, (b, c)) -> ((a, b), c)
forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k (a, (b, c)) ((a, b), c)
regroup ((a, (b, c)) -> ((a, b), c))
-> ((a, (b, c))
    -> LinearMap
         s
         (Needle a, (Needle b, Needle c))
         ((Needle a, Needle b), Needle c))
-> (a, (b, c))
-> (((a, b), c),
    LinearMap
      s
      (Needle a, (Needle b, Needle c))
      ((Needle a, Needle b), Needle c))
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& LinearMap
  s (Needle a, (Needle b, Needle c)) ((Needle a, Needle b), Needle c)
-> (a, (b, c))
-> LinearMap
     s (Needle a, (Needle b, Needle c)) ((Needle a, Needle b), Needle c)
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const LinearMap
  s (Needle a, (Needle b, Needle c)) ((Needle a, Needle b), Needle c)
forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k (a, (b, c)) ((a, b), c)
regroup
  regroup' :: Affine s ((a, b), c) (a, (b, c))
regroup' = (((ChartIndex a, ChartIndex b), ChartIndex c)
 :->: ((a, (b, c)),
       LinearMap
         s
         ((Needle a, Needle b), Needle c)
         (Needle a, (Needle b, Needle c))))
-> Affine s ((a, b), c) (a, (b, c))
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((((ChartIndex a, ChartIndex b), ChartIndex c)
  :->: ((a, (b, c)),
        LinearMap
          s
          ((Needle a, Needle b), Needle c)
          (Needle a, (Needle b, Needle c))))
 -> Affine s ((a, b), c) (a, (b, c)))
-> ((((ChartIndex a, ChartIndex b), ChartIndex c)
     -> ((a, (b, c)),
         LinearMap
           s
           ((Needle a, Needle b), Needle c)
           (Needle a, (Needle b, Needle c))))
    -> ((ChartIndex a, ChartIndex b), ChartIndex c)
       :->: ((a, (b, c)),
             LinearMap
               s
               ((Needle a, Needle b), Needle c)
               (Needle a, (Needle b, Needle c))))
-> (((ChartIndex a, ChartIndex b), ChartIndex c)
    -> ((a, (b, c)),
        LinearMap
          s
          ((Needle a, Needle b), Needle c)
          (Needle a, (Needle b, Needle c))))
-> Affine s ((a, b), c) (a, (b, c))
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
. (((ChartIndex a, ChartIndex b), ChartIndex c)
 -> ((a, (b, c)),
     LinearMap
       s
       ((Needle a, Needle b), Needle c)
       (Needle a, (Needle b, Needle c))))
-> ((ChartIndex a, ChartIndex b), ChartIndex c)
   :->: ((a, (b, c)),
         LinearMap
           s
           ((Needle a, Needle b), Needle c)
           (Needle a, (Needle b, Needle c)))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((((ChartIndex a, ChartIndex b), ChartIndex c)
  -> ((a, (b, c)),
      LinearMap
        s
        ((Needle a, Needle b), Needle c)
        (Needle a, (Needle b, Needle c))))
 -> Affine s ((a, b), c) (a, (b, c)))
-> (((ChartIndex a, ChartIndex b), ChartIndex c)
    -> ((a, (b, c)),
        LinearMap
          s
          ((Needle a, Needle b), Needle c)
          (Needle a, (Needle b, Needle c))))
-> Affine s ((a, b), c) (a, (b, c))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ((ChartIndex a, ChartIndex b), ChartIndex c) -> ((a, b), c)
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint (((ChartIndex a, ChartIndex b), ChartIndex c) -> ((a, b), c))
-> (((a, b), c)
    -> ((a, (b, c)),
        LinearMap
          s
          ((Needle a, Needle b), Needle c)
          (Needle a, (Needle b, Needle c))))
-> ((ChartIndex a, ChartIndex b), ChartIndex c)
-> ((a, (b, c)),
    LinearMap
      s
      ((Needle a, Needle b), Needle c)
      (Needle a, (Needle b, Needle c)))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> ((a, b), c) -> (a, (b, c))
forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup' (((a, b), c) -> (a, (b, c)))
-> (((a, b), c)
    -> LinearMap
         s
         ((Needle a, Needle b), Needle c)
         (Needle a, (Needle b, Needle c)))
-> ((a, b), c)
-> ((a, (b, c)),
    LinearMap
      s
      ((Needle a, Needle b), Needle c)
      (Needle a, (Needle b, Needle c)))
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&& LinearMap
  s ((Needle a, Needle b), Needle c) (Needle a, (Needle b, Needle c))
-> ((a, b), c)
-> LinearMap
     s ((Needle a, Needle b), Needle c) (Needle a, (Needle b, Needle c))
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const LinearMap
  s ((Needle a, Needle b), Needle c) (Needle a, (Needle b, Needle c))
forall (k :: * -> * -> *) a b c.
(Cartesian k, ObjectPair k a b, ObjectPair k b c,
 ObjectPair k a (b, c), ObjectPair k (a, b) c) =>
k ((a, b), c) (a, (b, c))
regroup'

instance ∀ s . (ScalarManifold s, Eq s) => Morphism (Affine s) where
  Affine ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c))
f *** :: Affine s b c -> Affine s b' c' -> Affine s (b, b') (c, c')
*** Affine ChartIndex b' :->: (c', LinearMap s (Needle b') (Needle c'))
g = ((ChartIndex b, ChartIndex b')
 :->: ((c, c'),
       LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
-> Affine s (b, b') (c, c')
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine (((ChartIndex b, ChartIndex b')
  :->: ((c, c'),
        LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
 -> Affine s (b, b') (c, c'))
-> (((ChartIndex b, ChartIndex b')
     -> ((c, c'),
         LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
    -> (ChartIndex b, ChartIndex b')
       :->: ((c, c'),
             LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
-> ((ChartIndex b, ChartIndex b')
    -> ((c, c'),
        LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
-> Affine s (b, b') (c, c')
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
. ((ChartIndex b, ChartIndex b')
 -> ((c, c'),
     LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
-> (ChartIndex b, ChartIndex b')
   :->: ((c, c'),
         LinearMap s (Needle b, Needle b') (Needle c, Needle c'))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie
      (((ChartIndex b, ChartIndex b')
  -> ((c, c'),
      LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
 -> Affine s (b, b') (c, c'))
-> ((ChartIndex b, ChartIndex b')
    -> ((c, c'),
        LinearMap s (Needle b, Needle b') (Needle c, Needle c')))
-> Affine s (b, b') (c, c')
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \(ChartIndex b
ixα,ChartIndex b'
ixβ) -> case ((ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c)))
-> ChartIndex b -> (c, LinearMap s (Needle b) (Needle c))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c))
f ChartIndex b
ixα, (ChartIndex b' :->: (c', LinearMap s (Needle b') (Needle c')))
-> ChartIndex b' -> (c', LinearMap s (Needle b') (Needle c'))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex b' :->: (c', LinearMap s (Needle b') (Needle c'))
g ChartIndex b'
ixβ) of
            ((c
fα, LinearMap s (Needle b) (Needle c)
ðα'f), (c'
gβ,LinearMap s (Needle b') (Needle c')
ðβ'g)) -> ((c
fα,c'
gβ), LinearMap s (Needle b) (Needle c)
ðα'fLinearMap s (Needle b) (Needle c)
-> LinearMap s (Needle b') (Needle c')
-> LinearMap s (Needle b, Needle b') (Needle c, Needle c')
forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
***LinearMap s (Needle b') (Needle c')
ðβ'g)
  
instance ∀ s . (ScalarManifold s, Eq s) => PreArrow (Affine s) where
  Affine ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c))
f &&& :: Affine s b c -> Affine s b c' -> Affine s b (c, c')
&&& Affine ChartIndex b :->: (c', LinearMap s (Needle b) (Needle c'))
g = (ChartIndex b
 :->: ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
-> Affine s b (c, c')
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex b
  :->: ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
 -> Affine s b (c, c'))
-> ((ChartIndex b
     -> ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
    -> ChartIndex b
       :->: ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
-> (ChartIndex b
    -> ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
-> Affine s b (c, c')
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
. (ChartIndex b
 -> ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
-> ChartIndex b
   :->: ((c, c'), LinearMap s (Needle b) (Needle c, Needle c'))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie
      ((ChartIndex b
  -> ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
 -> Affine s b (c, c'))
-> (ChartIndex b
    -> ((c, c'), LinearMap s (Needle b) (Needle c, Needle c')))
-> Affine s b (c, c')
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ChartIndex b
ix -> case ((ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c)))
-> ChartIndex b -> (c, LinearMap s (Needle b) (Needle c))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex b :->: (c, LinearMap s (Needle b) (Needle c))
f ChartIndex b
ix, (ChartIndex b :->: (c', LinearMap s (Needle b) (Needle c')))
-> ChartIndex b -> (c', LinearMap s (Needle b) (Needle c'))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex b :->: (c', LinearMap s (Needle b) (Needle c'))
g ChartIndex b
ix) of
            ((c
fα, LinearMap s (Needle b) (Needle c)
ðα'f), (c'
gβ,LinearMap s (Needle b) (Needle c')
ðβ'g)) -> ((c
fα,c'
gβ), LinearMap s (Needle b) (Needle c)
ðα'fLinearMap s (Needle b) (Needle c)
-> LinearMap s (Needle b) (Needle c')
-> LinearMap s (Needle b) (Needle c, Needle c')
forall (a :: * -> * -> *) b c c'.
(PreArrow a, Object a b, ObjectPair a c c') =>
a b c -> a b c' -> a b (c, c')
&&&LinearMap s (Needle b) (Needle c')
ðβ'g)
  terminal :: Affine s b (UnitObject (Affine s))
terminal = (ChartIndex b :->: (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
-> Affine s b (ZeroDim s)
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex b
  :->: (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
 -> Affine s b (ZeroDim s))
-> ((ChartIndex b
     -> (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
    -> ChartIndex b
       :->: (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
-> (ChartIndex b
    -> (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
-> Affine s b (ZeroDim 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
. (ChartIndex b -> (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
-> ChartIndex b
   :->: (ZeroDim s, LinearMap s (Needle b) (ZeroDim s))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex b -> (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
 -> Affine s b (ZeroDim s))
-> (ChartIndex b
    -> (ZeroDim s, LinearMap s (Needle b) (ZeroDim s)))
-> Affine s b (ZeroDim s)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ChartIndex b
_ -> (ZeroDim s
forall s. ZeroDim s
Origin, LinearMap s (Needle b) (ZeroDim s)
forall v. AdditiveGroup v => v
zeroV)
  fst :: Affine s (x, y) x
fst = Affine s (x, y) x
forall x y.
(Manifold (x, y), Atlas (x, y), LinearSpace (Needle x),
 LinearSpace (Needle y), Scalar (Needle x) ~ s,
 Scalar (Needle y) ~ s, HasTrie (ChartIndex x),
 HasTrie (ChartIndex y)) =>
Affine s (x, y) x
afst
   where afst :: ∀ x y . ( Manifold (x, y), Atlas (x, y)
                         , LinearSpace (Needle x), LinearSpace (Needle y)
                         , Scalar (Needle x) ~ s, Scalar (Needle y) ~ s
                         , HasTrie (ChartIndex x), HasTrie (ChartIndex y) )
                   => Affine s (x,y) x
         afst :: Affine s (x, y) x
afst = ((ChartIndex x, ChartIndex y)
 :->: (x, LinearMap s (Needle x, Needle y) (Needle x)))
-> Affine s (x, y) x
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine (((ChartIndex x, ChartIndex y)
  :->: (x, LinearMap s (Needle x, Needle y) (Needle x)))
 -> Affine s (x, y) x)
-> (((ChartIndex x, ChartIndex y)
     -> (x, LinearMap s (Needle x, Needle y) (Needle x)))
    -> (ChartIndex x, ChartIndex y)
       :->: (x, LinearMap s (Needle x, Needle y) (Needle x)))
-> ((ChartIndex x, ChartIndex y)
    -> (x, LinearMap s (Needle x, Needle y) (Needle x)))
-> Affine s (x, y) x
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
. ((ChartIndex x, ChartIndex y)
 -> (x, LinearMap s (Needle x, Needle y) (Needle x)))
-> (ChartIndex x, ChartIndex y)
   :->: (x, LinearMap s (Needle x, Needle y) (Needle x))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie (((ChartIndex x, ChartIndex y)
  -> (x, LinearMap s (Needle x, Needle y) (Needle x)))
 -> Affine s (x, y) x)
-> ((ChartIndex x, ChartIndex y)
    -> (x, LinearMap s (Needle x, Needle y) (Needle x)))
-> Affine s (x, y) x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Atlas (x, y) => ChartIndex (x, y) -> (x, y)
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint @(x,y) ((ChartIndex x, ChartIndex y) -> (x, y))
-> ((x, y) -> (x, LinearMap s (Needle x, Needle y) (Needle x)))
-> (ChartIndex x, ChartIndex y)
-> (x, LinearMap s (Needle x, Needle y) (Needle x))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \(x
x,y
_::y) -> (x
x, LinearMap s (Needle x, Needle y) (Needle x)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst)
  snd :: Affine s (x, y) y
snd = Affine s (x, y) y
forall x y.
(Manifold (x, y), Atlas (x, y), LinearSpace (Needle x),
 LinearSpace (Needle y), Scalar (Needle x) ~ s,
 Scalar (Needle y) ~ s, HasTrie (ChartIndex x),
 HasTrie (ChartIndex y)) =>
Affine s (x, y) y
asnd
   where asnd :: ∀ x y . ( Manifold (x, y), Atlas (x, y)
                         , LinearSpace (Needle x), LinearSpace (Needle y)
                         , Scalar (Needle x) ~ s, Scalar (Needle y) ~ s
                         , HasTrie (ChartIndex x), HasTrie (ChartIndex y) )
                   => Affine s (x,y) y
         asnd :: Affine s (x, y) y
asnd = ((ChartIndex x, ChartIndex y)
 :->: (y, LinearMap s (Needle x, Needle y) (Needle y)))
-> Affine s (x, y) y
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine (((ChartIndex x, ChartIndex y)
  :->: (y, LinearMap s (Needle x, Needle y) (Needle y)))
 -> Affine s (x, y) y)
-> (((ChartIndex x, ChartIndex y)
     -> (y, LinearMap s (Needle x, Needle y) (Needle y)))
    -> (ChartIndex x, ChartIndex y)
       :->: (y, LinearMap s (Needle x, Needle y) (Needle y)))
-> ((ChartIndex x, ChartIndex y)
    -> (y, LinearMap s (Needle x, Needle y) (Needle y)))
-> Affine s (x, y) y
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
. ((ChartIndex x, ChartIndex y)
 -> (y, LinearMap s (Needle x, Needle y) (Needle y)))
-> (ChartIndex x, ChartIndex y)
   :->: (y, LinearMap s (Needle x, Needle y) (Needle y))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie (((ChartIndex x, ChartIndex y)
  -> (y, LinearMap s (Needle x, Needle y) (Needle y)))
 -> Affine s (x, y) y)
-> ((ChartIndex x, ChartIndex y)
    -> (y, LinearMap s (Needle x, Needle y) (Needle y)))
-> Affine s (x, y) y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (ChartIndex x, ChartIndex y) -> (x, y)
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint ((ChartIndex x, ChartIndex y) -> (x, y))
-> ((x, y) -> (y, LinearMap s (Needle x, Needle y) (Needle y)))
-> (ChartIndex x, ChartIndex y)
-> (y, LinearMap s (Needle x, Needle y) (Needle y))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \(x
_::x,y
y) -> (y
y, LinearMap s (Needle x, Needle y) (Needle y)
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd)
  
instance ∀ s . (ScalarManifold s, Eq s) => WellPointed (Affine s) where
  const :: x -> Affine s b x
const x
x = (ChartIndex b :->: (x, LinearMap s (Needle b) (Needle x)))
-> Affine s b x
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex b :->: (x, LinearMap s (Needle b) (Needle x)))
 -> Affine s b x)
-> ((ChartIndex b -> (x, LinearMap s (Needle b) (Needle x)))
    -> ChartIndex b :->: (x, LinearMap s (Needle b) (Needle x)))
-> (ChartIndex b -> (x, LinearMap s (Needle b) (Needle x)))
-> Affine s b x
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
. (ChartIndex b -> (x, LinearMap s (Needle b) (Needle x)))
-> ChartIndex b :->: (x, LinearMap s (Needle b) (Needle x))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex b -> (x, LinearMap s (Needle b) (Needle x)))
 -> Affine s b x)
-> (ChartIndex b -> (x, LinearMap s (Needle b) (Needle x)))
-> Affine s b x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (x, LinearMap s (Needle b) (Needle x))
-> ChartIndex b -> (x, LinearMap s (Needle b) (Needle x))
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const (x
x, LinearMap s (Needle b) (Needle x)
forall v. AdditiveGroup v => v
zeroV)
  unit :: CatTagged (Affine s) (UnitObject (Affine s))
unit = ZeroDim s -> Tagged (Affine s (ZeroDim s) (ZeroDim s)) (ZeroDim s)
forall k (s :: k) b. b -> Tagged s b
Tagged ZeroDim s
forall s. ZeroDim s
Origin
  
instance EnhancedCat (->) (Affine s) where
  arr :: Affine s b c -> b -> c
arr Affine s b c
f = (c, LinearMap s (Needle b) (Needle c)) -> c
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst ((c, LinearMap s (Needle b) (Needle c)) -> c)
-> (b -> (c, LinearMap s (Needle b) (Needle c))) -> b -> c
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
. Affine s b c -> b -> (c, LinearMap s (Needle b) (Needle c))
forall x y s.
(Manifold x, Atlas x, HasTrie (ChartIndex x), Manifold y,
 s ~ Scalar (Needle x), s ~ Scalar (Needle y)) =>
Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine Affine s b c
f
  
instance EnhancedCat (Affine s) (LinearMap s) where
  arr :: LinearMap s b c -> Affine s b c
arr = (LinearManifoldWitness b, LinearManifoldWitness c)
-> LinearMap s b c -> Affine s b c
forall x y.
(LinearSpace x, Atlas x, HasTrie (ChartIndex x), LinearSpace y,
 Scalar x ~ s, Scalar y ~ s) =>
(LinearManifoldWitness x, LinearManifoldWitness y)
-> LinearMap s x y -> Affine s x y
alarr (LinearManifoldWitness b
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness, LinearManifoldWitness c
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness)
   where alarr :: ∀ x y . ( LinearSpace x, Atlas x, HasTrie (ChartIndex x)
                          , LinearSpace y
                          , Scalar x ~ s, Scalar y ~ s )
             => (LinearManifoldWitness x, LinearManifoldWitness y)
                  -> LinearMap s x y -> Affine s x y
         alarr :: (LinearManifoldWitness x, LinearManifoldWitness y)
-> LinearMap s x y -> Affine s x y
alarr (LinearManifoldWitness x
LinearManifoldWitness, LinearManifoldWitness y
LinearManifoldWitness) LinearMap s x y
f
             = (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
    -> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
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
. (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ChartIndex x -> x
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint
                   (ChartIndex x -> x)
-> (x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x
-> (y, LinearMap s (Needle x) (Needle y))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \x
x₀ -> let y₀ :: y
y₀ = LinearMap s x y
f LinearMap s x y -> x -> y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x₀
                              in (y -> y
forall v. AdditiveGroup v => v -> v
negateV y
y₀, LinearMap s x y
f)

instance ( Atlas x, HasTrie (ChartIndex x), Manifold y
         , LinearManifold (Needle x), Scalar (Needle x) ~ s
         , LinearManifold (Needle y), Scalar (Needle y) ~ s
         ) => Semimanifold (Affine s x y) where
  type Needle (Affine s x y) = Affine s x (Needle y)
  .+~^ :: Affine s x y -> Needle (Affine s x y) -> Affine s x y
(.+~^) = case ( SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness y ) of
    (SemimanifoldWitness y
SemimanifoldWitness) -> \(Affine ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f) (Affine g)
      -> (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
    -> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
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
. (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ChartIndex x
ix -> case ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x -> (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f ChartIndex x
ix, (ChartIndex x :->: (Needle y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x -> (Needle y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex x :->: (Needle y, LinearMap s (Needle x) (Needle y))
ChartIndex x
:->: (Needle y, LinearMap s (Needle x) (Needle (Needle y)))
g ChartIndex x
ix) of
          ((y
fx₀,LinearMap s (Needle x) (Needle y)
f'), (Needle y
gx₀,LinearMap s (Needle x) (Needle y)
g')) -> (y
fx₀y -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
gx₀, LinearMap s (Needle x) (Needle y)
f'LinearMap s (Needle x) (Needle y)
-> LinearMap s (Needle x) (Needle y)
-> LinearMap s (Needle x) (Needle y)
forall v. AdditiveGroup v => v -> v -> v
^+^LinearMap s (Needle x) (Needle y)
g')
  semimanifoldWitness :: SemimanifoldWitness (Affine s x y)
semimanifoldWitness = case SemimanifoldWithBoundary y => SmfdWBoundWitness y
forall m. SemimanifoldWithBoundary m => SmfdWBoundWitness m
smfdWBoundWitness @y of
    SmfdWBoundWitness y
OpenManifoldWitness -> case Semimanifold y => SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness @y of
        SemimanifoldWitness y
SemimanifoldWitness -> (OpenManifold (Needle (Interior y)) =>
 SemimanifoldWitness (Affine s x y))
-> SemimanifoldWitness (Affine s x y)
forall m r.
SemimanifoldWithBoundary m =>
(OpenManifold (Needle (Interior m)) => r) -> r
needleIsOpenMfd @y OpenManifold (Needle (Interior y)) =>
SemimanifoldWitness (Affine s x y)
forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness
instance ( Atlas x, HasTrie (ChartIndex x), Manifold y
         , LinearManifold (Needle x), Scalar (Needle x) ~ s
         , LinearManifold (Needle y), Scalar (Needle y) ~ s
         ) => PseudoAffine (Affine s x y) where
  Affine s x y
p.-~. :: Affine s x y -> Affine s x y -> Maybe (Needle (Affine s x y))
.-~.Affine s x y
q = Affine s x (Needle y) -> Maybe (Affine s x (Needle y))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a.
(Applicative f r t, Object r a, Object t (f a)) =>
t a (f a)
pure (Affine s x y
pAffine s x y -> Affine s x y -> Needle (Affine s x y)
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!Affine s x y
q)
  .-~! :: Affine s x y -> Affine s x y -> Needle (Affine s x y)
(.-~!) = case ( SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness y ) of
    (SemimanifoldWitness y
SemimanifoldWitness) -> \(Affine ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f) (Affine ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
g)
      -> (ChartIndex x
 :->: (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
-> Affine s x (Needle y)
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x
  :->: (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
 -> Affine s x (Needle y))
-> ((ChartIndex x
     -> (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
    -> ChartIndex x
       :->: (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
-> (ChartIndex x
    -> (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
-> Affine s x (Needle y)
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
. (ChartIndex x
 -> (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
-> ChartIndex x
   :->: (Needle y, LinearMap s (Needle x) (Needle (Needle y)))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x
  -> (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
 -> Affine s x (Needle y))
-> (ChartIndex x
    -> (Needle y, LinearMap s (Needle x) (Needle (Needle y))))
-> Affine s x (Needle y)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \ChartIndex x
ix -> case ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle (Needle y))))
-> ChartIndex x -> (y, LinearMap s (Needle x) (Needle (Needle y)))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
ChartIndex x :->: (y, LinearMap s (Needle x) (Needle (Needle y)))
f ChartIndex x
ix, (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle (Needle y))))
-> ChartIndex x -> (y, LinearMap s (Needle x) (Needle (Needle y)))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
ChartIndex x :->: (y, LinearMap s (Needle x) (Needle (Needle y)))
g ChartIndex x
ix) of
          ((y
fx₀,LinearMap s (Needle x) (Needle (Needle y))
f'), (y
gx₀,LinearMap s (Needle x) (Needle (Needle y))
g')) -> (y
fx₀y -> y -> Needle y
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
.-~!y
gx₀, LinearMap s (Needle x) (Needle (Needle y))
f'LinearMap s (Needle x) (Needle (Needle y))
-> LinearMap s (Needle x) (Needle (Needle y))
-> LinearMap s (Needle x) (Needle (Needle y))
forall v. AdditiveGroup v => v -> v -> v
^-^LinearMap s (Needle x) (Needle (Needle y))
g')
  pseudoAffineWitness :: PseudoAffineWitness (Affine s x y)
pseudoAffineWitness = case SemimanifoldWitness y
forall x. Semimanifold x => SemimanifoldWitness x
semimanifoldWitness :: SemimanifoldWitness y of
    SemimanifoldWitness y
SemimanifoldWitness -> SemimanifoldWitness (Affine s x y)
-> PseudoAffineWitness (Affine s x y)
forall x.
PseudoAffine (Needle x) =>
SemimanifoldWitness x -> PseudoAffineWitness x
PseudoAffineWitness (SemimanifoldWitness (Affine s x y)
forall x.
(Semimanifold (Needle x), Needle (Needle x) ~ Needle x) =>
SemimanifoldWitness x
SemimanifoldWitness)
instance ( Atlas x, HasTrie (ChartIndex x)
         , LinearManifold (Needle x), Scalar (Needle x) ~ s
         , LinearManifold (Needle y), Scalar (Needle y) ~ s
         , Manifold y, Scalar (Needle y) ~ s )
              => AffineSpace (Affine s x y) where
  type Diff (Affine s x y) = Affine s x (Needle y)
  .+^ :: Affine s x y -> Diff (Affine s x y) -> Affine s x y
(.+^) = Affine s x y -> Diff (Affine s x y) -> Affine s x y
forall x. Semimanifold x => x -> Needle x -> x
(.+~^); .-. :: Affine s x y -> Affine s x y -> Diff (Affine s x y)
(.-.) = Affine s x y -> Affine s x y -> Diff (Affine s x y)
forall x. (PseudoAffine x, HasCallStack) => x -> x -> Needle x
(.-~!)
instance ( Atlas x, HasTrie (ChartIndex x)
         , LinearManifold (Needle x), Scalar (Needle x) ~ s
         , LinearManifold y, Scalar y ~ s, Num' s )
            => AdditiveGroup (Affine s x y) where
  zeroV :: Affine s x y
zeroV = case LinearManifoldWitness y
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness y of
       LinearManifoldWitness y
LinearManifoldWitness -> (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
    -> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
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
. (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (y, LinearMap s (Needle x) (Needle y))
-> ChartIndex x -> (y, LinearMap s (Needle x) (Needle y))
forall (a :: * -> * -> *) b x.
(WellPointed a, Object a b, ObjectPoint a x) =>
x -> a b x
const (y
forall v. AdditiveGroup v => v
zeroV, LinearMap s (Needle x) (Needle y)
forall v. AdditiveGroup v => v
zeroV)
  ^+^ :: Affine s x y -> Affine s x y -> Affine s x y
(^+^) = case ( LinearManifoldWitness y
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness y
               , DualSpaceWitness y
forall v. LinearSpace v => DualSpaceWitness v
dualSpaceWitness :: DualSpaceWitness y ) of
      (LinearManifoldWitness y
LinearManifoldWitness, DualSpaceWitness y
DualSpaceWitness) -> Affine s x y -> Affine s x y -> Affine s x y
forall x. Semimanifold x => x -> Needle x -> x
(.+~^)
  negateV :: Affine s x y -> Affine s x y
negateV = case LinearManifoldWitness y
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness y of
       LinearManifoldWitness y
LinearManifoldWitness -> \(Affine ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f) -> (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
    -> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
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
. (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
             (ChartIndex x :->: (y, LinearMap s (Needle x) y))
-> ChartIndex x -> (y, LinearMap s (Needle x) y)
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex x :->: (y, LinearMap s (Needle x) y)
ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f (ChartIndex x -> (y, LinearMap s (Needle x) y))
-> ((y, LinearMap s (Needle x) y)
    -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x
-> (y, LinearMap s (Needle x) (Needle y))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> y -> y
forall v. AdditiveGroup v => v -> v
negateV(y -> y)
-> (LinearMap s (Needle x) y -> LinearMap s (Needle x) (Needle y))
-> (y, LinearMap s (Needle x) y)
-> (y, LinearMap s (Needle x) (Needle y))
forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
***LinearMap s (Needle x) y -> LinearMap s (Needle x) (Needle y)
forall v. AdditiveGroup v => v -> v
negateV
instance ( Atlas x, HasTrie (ChartIndex x)
         , LinearManifold (Needle x), Scalar (Needle x) ~ s
         , LinearManifold y, Scalar y ~ s, Num' s )
            => VectorSpace (Affine s x y) where
  type Scalar (Affine s x y) = s
  *^ :: Scalar (Affine s x y) -> Affine s x y -> Affine s x y
(*^) = case LinearManifoldWitness y
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness y of
       LinearManifoldWitness y
LinearManifoldWitness -> \Scalar (Affine s x y)
μ (Affine ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f) -> (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
    -> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
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
. (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$
             (ChartIndex x :->: (y, LinearMap s (Needle x) y))
-> ChartIndex x -> (y, LinearMap s (Needle x) y)
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex x :->: (y, LinearMap s (Needle x) y)
ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f (ChartIndex x -> (y, LinearMap s (Needle x) y))
-> ((y, LinearMap s (Needle x) y)
    -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x
-> (y, LinearMap s (Needle x) (Needle y))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> (Scalar y
Scalar (Affine s x y)
μScalar y -> y -> y
forall v. VectorSpace v => Scalar v -> v -> v
*^)(y -> y)
-> (LinearMap s (Needle x) y -> LinearMap s (Needle x) (Needle y))
-> (y, LinearMap s (Needle x) y)
-> (y, LinearMap s (Needle x) (Needle y))
forall (a :: * -> * -> *) b b' c c'.
(Morphism a, ObjectPair a b b', ObjectPair a c c') =>
a b c -> a b' c' -> a (b, b') (c, c')
***(Scalar (LinearMap s (Needle x) (Needle y))
Scalar (Affine s x y)
μScalar (LinearMap s (Needle x) (Needle y))
-> LinearMap s (Needle x) (Needle y)
-> LinearMap s (Needle x) (Needle y)
forall v. VectorSpace v => Scalar v -> v -> v
*^)

evalAffine :: ∀ x y s . ( Manifold x, Atlas x, HasTrie (ChartIndex x)
                        , Manifold y
                        , s ~ Scalar (Needle x), s ~ Scalar (Needle y) )
               => Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine :: Affine s x y -> x -> (y, LinearMap s (Needle x) (Needle y))
evalAffine (Affine ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f) x
x = (y
fx₀y -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^(LinearMap s (Needle x) (Needle y)
ðx'f LinearMap s (Needle x) (Needle y) -> Needle x -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ Needle x
v), LinearMap s (Needle x) (Needle y)
ðx'f)
 where Just Needle x
v = x
x x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. ChartIndex x -> x
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint ChartIndex x
chIx
       chIx :: ChartIndex x
chIx = x -> ChartIndex x
forall m. Atlas m => m -> ChartIndex m
lookupAtlas x
x
       (y
fx₀, LinearMap s (Needle x) (Needle y)
ðx'f) = (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x -> (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a :->: b) -> a -> b
untrie ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
f ChartIndex x
chIx

fromOffsetSlope :: ∀ x y s . ( LinearSpace x, Atlas x, HasTrie (ChartIndex x)
                             , Manifold y
                             , s ~ Scalar x, s ~ Scalar (Needle y) )
               => y -> LinearMap s x (Needle y) -> Affine s x y
fromOffsetSlope :: y -> LinearMap s x (Needle y) -> Affine s x y
fromOffsetSlope = case ( LinearManifoldWitness x
forall v. TensorSpace v => LinearManifoldWitness v
linearManifoldWitness :: LinearManifoldWitness x ) of
   (LinearManifoldWitness x
LinearManifoldWitness)
       -> \y
y0 LinearMap s x (Needle y)
ðx'y -> (ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
    -> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y)))
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
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
. (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x :->: (y, LinearMap s (Needle x) (Needle y))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
 -> Affine s x y)
-> (ChartIndex x -> (y, LinearMap s (Needle x) (Needle y)))
-> Affine s x y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ChartIndex x -> x
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint
                    (ChartIndex x -> x)
-> (x -> (y, LinearMap s (Needle x) (Needle y)))
-> ChartIndex x
-> (y, LinearMap s (Needle x) (Needle y))
forall (k :: * -> * -> *) a b c.
(Category k, Object k a, Object k b, Object k c) =>
k a b -> k b c -> k a c
>>> \x
x₀ -> let δy :: Needle y
δy = LinearMap s x (Needle y)
ðx'y LinearMap s x (Needle y) -> x -> Needle y
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ x
x₀
                               in (y
y0y -> Needle y -> y
forall x. Semimanifold x => x -> Needle x -> x
.+~^Needle y
δy, LinearMap s x (Needle y)
ðx'y)


instance EnhancedCat (Embedding (Affine s)) (Embedding (LinearMap s)) where
  arr :: Embedding (LinearMap s) b c -> Embedding (Affine s) b c
arr (Embedding LinearMap s b c
e LinearMap s c b
p) = Affine s b c -> Affine s c b -> Embedding (Affine s) b c
forall (c :: * -> * -> *) a b. c a b -> c b a -> Embedding c a b
Embedding (LinearMap s b c -> Affine s b c
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr LinearMap s b c
e) (LinearMap s c b -> Affine s c b
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr LinearMap s c b
p)


lensEmbedding :: ∀ k x c s .
                 ( Num' s
                 , LinearSpace x, LinearSpace c, Object k x, Object k c
                 , Scalar x ~ s, Scalar c ~ s
                 , EnhancedCat k (LinearMap s) )
                  => Lens' x c -> Embedding k c x
lensEmbedding :: Lens' x c -> Embedding k c x
lensEmbedding Lens' x c
l = k c x -> k x c -> Embedding k c x
forall (c :: * -> * -> *) a b. c a b -> c b a -> Embedding c a b
Embedding (LinearMap s c x -> k c x
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (LinearMap s c x -> k c x) -> LinearMap s c x -> k c x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearFunction s c x -> LinearMap s c x
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (LinearFunction s c x -> LinearMap s c x)
-> LinearFunction s c x -> LinearMap s c x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (c -> x) -> LinearFunction s c x
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (\c
c -> x
forall v. AdditiveGroup v => v
zeroV x -> (x -> x) -> x
forall a b. a -> (a -> b) -> b
& (c -> Identity c) -> x -> Identity x
Lens' x c
l ((c -> Identity c) -> x -> Identity x) -> c -> x -> x
forall s t a b. ASetter s t a b -> b -> s -> t
.~ c
c)
                                     :: LinearMap s c x) )
                            (LinearMap s x c -> k x c
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (LinearMap s x c -> k x c) -> LinearMap s x c -> k x c
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (LinearFunction s x c -> LinearMap s x c
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (LinearFunction s x c -> LinearMap s x c)
-> LinearFunction s x c -> LinearMap s x c
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (x -> c) -> LinearFunction s x c
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction (x -> Getting c x c -> c
forall s a. s -> Getting a s a -> a
^.Getting c x c
Lens' x c
l)
                                     :: LinearMap s x c) )


correspondingDirections :: ∀ x c t s
                        . ( WithField s AffineManifold c
                          , WithField s AffineManifold x
                          , SemiInner (Needle c), SemiInner (Needle x)
                          , RealFrac' s
                          , Traversable t )
         => (c, x) -> t (Needle c, Needle x) -> Maybe (Embedding (Affine s) c x)
correspondingDirections :: (c, x)
-> t (Needle c, Needle x) -> Maybe (Embedding (Affine s) c x)
correspondingDirections (c
c₀, x
x₀) t (Needle c, Needle x)
dirMap
   = Maybe
  (ReifiedLens' (Diff c) (t (Scalar (Needle c))),
   ReifiedLens' (Diff x) (t (Scalar (Needle x))))
freeEmbeddings Maybe
  (ReifiedLens' (Diff c) (t (Scalar (Needle c))),
   ReifiedLens' (Diff x) (t (Scalar (Needle x))))
-> Embedding (Affine s) c x -> Maybe (Embedding (Affine s) c x)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Affine s c x -> Affine s x c -> Embedding (Affine s) c x
forall (c :: * -> * -> *) a b. c a b -> c b a -> Embedding c a b
Embedding ((ChartIndex c :->: (x, LinearMap s (Needle c) (Needle x)))
-> Affine s c x
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex c :->: (x, LinearMap s (Needle c) (Needle x)))
 -> Affine s c x)
-> ((ChartIndex c -> (x, LinearMap s (Needle c) (Needle x)))
    -> ChartIndex c :->: (x, LinearMap s (Needle c) (Needle x)))
-> (ChartIndex c -> (x, LinearMap s (Needle c) (Needle x)))
-> Affine s c x
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
. (ChartIndex c -> (x, LinearMap s (Needle c) (Needle x)))
-> ChartIndex c :->: (x, LinearMap s (Needle c) (Needle x))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex c -> (x, LinearMap s (Needle c) (Needle x)))
 -> Affine s c x)
-> (ChartIndex c -> (x, LinearMap s (Needle c) (Needle x)))
-> Affine s c x
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ChartIndex c -> (x, LinearMap s (Needle c) (Needle x))
c2x)
                                 ((ChartIndex x :->: (c, LinearMap s (Needle x) (Needle c)))
-> Affine s x c
forall d c s.
(ChartIndex d :->: (c, LinearMap s (Needle d) (Needle c)))
-> Affine s d c
Affine ((ChartIndex x :->: (c, LinearMap s (Needle x) (Needle c)))
 -> Affine s x c)
-> ((ChartIndex x -> (c, LinearMap s (Needle x) (Needle c)))
    -> ChartIndex x :->: (c, LinearMap s (Needle x) (Needle c)))
-> (ChartIndex x -> (c, LinearMap s (Needle x) (Needle c)))
-> Affine s x c
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
. (ChartIndex x -> (c, LinearMap s (Needle x) (Needle c)))
-> ChartIndex x :->: (c, LinearMap s (Needle x) (Needle c))
forall a b. HasTrie a => (a -> b) -> a :->: b
trie ((ChartIndex x -> (c, LinearMap s (Needle x) (Needle c)))
 -> Affine s x c)
-> (ChartIndex x -> (c, LinearMap s (Needle x) (Needle c)))
-> Affine s x c
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ ChartIndex x -> (c, LinearMap s (Needle x) (Needle c))
x2c)
 where freeEmbeddings :: Maybe
  (ReifiedLens' (Diff c) (t (Scalar (Needle c))),
   ReifiedLens' (Diff x) (t (Scalar (Needle x))))
freeEmbeddings = (Maybe (ReifiedLens' (Diff c) (t (Scalar (Needle c)))),
 Maybe (ReifiedLens' (Diff x) (t (Scalar (Needle x)))))
-> Maybe
     (ReifiedLens' (Diff c) (t (Scalar (Needle c))),
      ReifiedLens' (Diff x) (t (Scalar (Needle x))))
forall (f :: * -> *) (r :: * -> * -> *) (t :: * -> * -> *) a b.
(Monoidal f r t, ObjectPair r a b, ObjectPair t (f a) (f b),
 Object t (f (a, b))) =>
t (f a, f b) (f (a, b))
fzip ( t (Diff c) -> Maybe (ReifiedLens' (Diff c) (t (Scalar (Needle c))))
forall v (t :: * -> *) r.
(HasCallStack, SemiInner v, RealFrac' (Scalar v), Traversable t) =>
t v -> Maybe (ReifiedLens' v (t (Scalar v)))
embedFreeSubspace (t (Diff c)
 -> Maybe (ReifiedLens' (Diff c) (t (Scalar (Needle c)))))
-> t (Diff c)
-> Maybe (ReifiedLens' (Diff c) (t (Scalar (Needle c))))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Diff c, Diff x) -> Diff c
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) x
fst((Diff c, Diff x) -> Diff c) -> t (Diff c, Diff x) -> t (Diff c)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>t (Diff c, Diff x)
t (Needle c, Needle x)
dirMap
                             , t (Diff x) -> Maybe (ReifiedLens' (Diff x) (t (Scalar (Needle x))))
forall v (t :: * -> *) r.
(HasCallStack, SemiInner v, RealFrac' (Scalar v), Traversable t) =>
t v -> Maybe (ReifiedLens' v (t (Scalar v)))
embedFreeSubspace (t (Diff x)
 -> Maybe (ReifiedLens' (Diff x) (t (Scalar (Needle x)))))
-> t (Diff x)
-> Maybe (ReifiedLens' (Diff x) (t (Scalar (Needle x))))
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ (Diff c, Diff x) -> Diff x
forall (a :: * -> * -> *) x y.
(PreArrow a, ObjectPair a x y) =>
a (x, y) y
snd((Diff c, Diff x) -> Diff x) -> t (Diff c, Diff x) -> t (Diff x)
forall (f :: * -> *) (r :: * -> * -> *) a b.
(Functor f r (->), Object r a, Object r b) =>
r a b -> f a -> f b
<$>t (Diff c, Diff x)
t (Needle c, Needle x)
dirMap )
       c2t :: Lens' (Needle c) (t s)
       c2t :: (t s -> f (t s)) -> Needle c -> f (Needle c)
c2t = case Maybe
  (ReifiedLens' (Diff c) (t (Scalar (Needle c))),
   ReifiedLens' (Diff x) (t (Scalar (Needle x))))
freeEmbeddings of Just (Lens ct, _) -> (t s -> f (t s)) -> Needle c -> f (Needle c)
Lens (Diff c) (Diff c) (t s) (t s)
ct
       x2t :: Lens' (Needle x) (t s)
       x2t :: (t s -> f (t s)) -> Needle x -> f (Needle x)
x2t = case Maybe
  (ReifiedLens' (Diff c) (t (Scalar (Needle c))),
   ReifiedLens' (Diff x) (t (Scalar (Needle x))))
freeEmbeddings of Just (_, Lens xt) -> (t s -> f (t s)) -> Needle x -> f (Needle x)
Lens (Diff x) (Diff x) (t s) (t s)
xt
       c2x :: ChartIndex c -> (x, LinearMap s (Needle c) (Needle x))
       c2x :: ChartIndex c -> (x, LinearMap s (Needle c) (Needle x))
c2x ChartIndex c
ιc
              = ( x
x₀ x -> Needle x -> x
forall x. Semimanifold x => x -> Needle x -> x
.+~^ (Diff x
forall v. AdditiveGroup v => v
zeroV Diff x -> (Diff x -> Diff x) -> Diff x
forall a b. a -> (a -> b) -> b
& (t s -> Identity (t s)) -> Diff x -> Identity (Diff x)
Lens' (Needle x) (t s)
x2t ((t s -> Identity (t s)) -> Diff x -> Identity (Diff x))
-> t s -> Diff x -> Diff x
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Diff c
δcDiff c -> Getting (t s) (Diff c) (t s) -> t s
forall s a. s -> Getting a s a -> a
^.Getting (t s) (Diff c) (t s)
Lens' (Needle c) (t s)
c2t)
                , LinearFunction s (Diff c) (Diff x) -> LinearMap s (Diff c) (Diff x)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (LinearFunction s (Diff c) (Diff x)
 -> LinearMap s (Diff c) (Diff x))
-> ((Diff c -> Diff x) -> LinearFunction s (Diff c) (Diff x))
-> (Diff c -> Diff x)
-> LinearMap s (Diff c) (Diff x)
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
. (Diff c -> Diff x) -> LinearFunction s (Diff c) (Diff x)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Diff c -> Diff x) -> LinearMap s (Diff c) (Diff x))
-> (Diff c -> Diff x) -> LinearMap s (Diff c) (Diff x)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Diff c
dc -> Diff x
forall v. AdditiveGroup v => v
zeroV Diff x -> (Diff x -> Diff x) -> Diff x
forall a b. a -> (a -> b) -> b
& (t s -> Identity (t s)) -> Diff x -> Identity (Diff x)
Lens' (Needle x) (t s)
x2t ((t s -> Identity (t s)) -> Diff x -> Identity (Diff x))
-> t s -> Diff x -> Diff x
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Diff c
dcDiff c -> Getting (t s) (Diff c) (t s) -> t s
forall s a. s -> Getting a s a -> a
^.Getting (t s) (Diff c) (t s)
Lens' (Needle c) (t s)
c2t )
        where Just Diff c
δc = ChartIndex c -> c
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint ChartIndex c
ιc c -> c -> Maybe (Needle c)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. c
c₀
       x2c :: ChartIndex x
                            -> (c, LinearMap s (Needle x) (Needle c))
       x2c :: ChartIndex x -> (c, LinearMap s (Needle x) (Needle c))
x2c ChartIndex x
ιx
              = ( c
c₀ c -> Needle c -> c
forall x. Semimanifold x => x -> Needle x -> x
.+~^ (Diff c
forall v. AdditiveGroup v => v
zeroV Diff c -> (Diff c -> Diff c) -> Diff c
forall a b. a -> (a -> b) -> b
& (t s -> Identity (t s)) -> Diff c -> Identity (Diff c)
Lens' (Needle c) (t s)
c2t ((t s -> Identity (t s)) -> Diff c -> Identity (Diff c))
-> t s -> Diff c -> Diff c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Diff x
δxDiff x -> Getting (t s) (Diff x) (t s) -> t s
forall s a. s -> Getting a s a -> a
^.Getting (t s) (Diff x) (t s)
Lens' (Needle x) (t s)
x2t)
                , LinearFunction s (Diff x) (Diff c) -> LinearMap s (Diff x) (Diff c)
forall (a :: * -> * -> *) (k :: * -> * -> *) b c.
(EnhancedCat a k, Object k b, Object k c, Object a b,
 Object a c) =>
k b c -> a b c
arr (LinearFunction s (Diff x) (Diff c)
 -> LinearMap s (Diff x) (Diff c))
-> ((Diff x -> Diff c) -> LinearFunction s (Diff x) (Diff c))
-> (Diff x -> Diff c)
-> LinearMap s (Diff x) (Diff c)
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
. (Diff x -> Diff c) -> LinearFunction s (Diff x) (Diff c)
forall s v w. (v -> w) -> LinearFunction s v w
LinearFunction ((Diff x -> Diff c) -> LinearMap s (Diff x) (Diff c))
-> (Diff x -> Diff c) -> LinearMap s (Diff x) (Diff c)
forall (f :: * -> * -> *) a b.
(Function f, Object f a, Object f b) =>
f a b -> a -> b
$ \Diff x
dx -> Diff c
forall v. AdditiveGroup v => v
zeroV Diff c -> (Diff c -> Diff c) -> Diff c
forall a b. a -> (a -> b) -> b
& (t s -> Identity (t s)) -> Diff c -> Identity (Diff c)
Lens' (Needle c) (t s)
c2t ((t s -> Identity (t s)) -> Diff c -> Identity (Diff c))
-> t s -> Diff c -> Diff c
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Diff x
dxDiff x -> Getting (t s) (Diff x) (t s) -> t s
forall s a. s -> Getting a s a -> a
^.Getting (t s) (Diff x) (t s)
Lens' (Needle x) (t s)
x2t )
        where Just Diff x
δx = ChartIndex x -> x
forall m. Atlas m => ChartIndex m -> m
chartReferencePoint ChartIndex x
ιx x -> x -> Maybe (Needle x)
forall x. PseudoAffine x => x -> x -> Maybe (Needle x)
.-~. x
x₀