{-# OPTIONS_GHC -fplugin=GHC.TypeLits.KnownNat.Solver -fplugin=GHC.TypeLits.Normalise -fconstraint-solver-iterations=10 #-}
{-# LANGUAGE UndecidableInstances,UndecidableSuperClasses #-}
-- | This module provides tools for working with linear and affine
-- transformations.

module Goal.Geometry.Map.Linear
    ( -- * Bilinear Forms
    Bilinear ((>$<),(>.<),transpose)
    , (<.<)
    , (<$<)
    -- * Tensors
    , Tensor
    -- ** Matrix Construction
    , toMatrix
    , fromMatrix
    , toRows
    , toColumns
    , fromRows
    , fromColumns
    -- ** Computation
    --, (<#>)
    , inverse
    , determinant
    -- * Affine Functions
    , Affine (Affine)
    , Translation ((>+>),anchor)
    , (>.+>)
    , (>$+>)
    , type (<*)
    ) where

--- Imports ---

-- Package --

import Goal.Core

import Goal.Geometry.Manifold
import Goal.Geometry.Vector
import Goal.Geometry.Map

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


-- Bilinear Forms --


-- | A 'Manifold' is 'Bilinear' if its elements are bilinear forms.
class (Bilinear f x y, Manifold x, Manifold y, Manifold (f x y)) => Bilinear f y x where
    -- | Tensor outer product.
    (>.<) :: c # y -> c # x -> c # f y x
    -- | Average of tensor outer products.
    (>$<) :: [c # y] -> [c # x] -> c # f y x
    -- | Tensor transpose.
    transpose :: c # f y x -> c # f x y

-- | Transposed application.
(<.<) :: (Map c f x y, Bilinear f y x) => c #* y -> c # f y x -> c # x
{-# INLINE (<.<) #-}
<.< :: (c #* y) -> (c # f y x) -> c # x
(<.<) c #* y
dy c # f y x
f = (c # f y x) -> c # f x y
forall (f :: Type -> Type -> Type) y x c.
Bilinear f y x =>
(c # f y x) -> c # f x y
transpose c # f y x
f (c # f x y) -> (c #* y) -> c # x
forall c (f :: Type -> Type -> Type) y x.
Map c f y x =>
(c # f y x) -> (c #* x) -> c # y
>.> c #* y
dy

-- | Mapped transposed application.
(<$<) :: (Map c f x y, Bilinear f y x) => [c #* y] -> c # f y x -> [c # x]
{-# INLINE (<$<) #-}
<$< :: [c #* y] -> (c # f y x) -> [c # x]
(<$<) [c #* y]
dy c # f y x
f = (c # f y x) -> c # f x y
forall (f :: Type -> Type -> Type) y x c.
Bilinear f y x =>
(c # f y x) -> c # f x y
transpose c # f y x
f (c # f x y) -> [c #* y] -> [c # x]
forall c (f :: Type -> Type -> Type) y x.
Map c f y x =>
(c # f y x) -> [c #* x] -> [c # y]
>$> [c #* y]
dy


-- Tensor Products --

-- | 'Manifold' of 'Tensor's given by the tensor product of the underlying pair of 'Manifold's.
data Tensor y x

-- | The inverse of a tensor.
inverse
    :: (Manifold x, Manifold y, Dimension x ~ Dimension y)
    => c # Tensor y x -> c #* Tensor x y
{-# INLINE inverse #-}
inverse :: (c # Tensor y x) -> c #* Tensor x y
inverse c # Tensor y x
p = Matrix Vector (Dimension y) (Dimension y) Double -> c #* Tensor x y
forall y x c.
Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
fromMatrix (Matrix Vector (Dimension y) (Dimension y) Double
 -> c #* Tensor x y)
-> (Matrix Vector (Dimension y) (Dimension y) Double
    -> Matrix Vector (Dimension y) (Dimension y) Double)
-> Matrix Vector (Dimension y) (Dimension y) Double
-> c #* Tensor x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix Vector (Dimension y) (Dimension y) Double
-> Matrix Vector (Dimension y) (Dimension y) Double
forall (n :: Nat) x.
(KnownNat n, Field x) =>
Matrix n n x -> Matrix n n x
S.pseudoInverse (Matrix Vector (Dimension y) (Dimension y) Double
 -> c #* Tensor x y)
-> Matrix Vector (Dimension y) (Dimension y) Double
-> c #* Tensor x y
forall a b. (a -> b) -> a -> b
$ (c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
forall x y c.
(Manifold x, Manifold y) =>
(c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
toMatrix c # Tensor y x
p

-- | The determinant of a tensor.
determinant
    :: (Manifold x, Manifold y, Dimension x ~ Dimension y)
    => c # Tensor y x
    -> Double
{-# INLINE determinant #-}
determinant :: (c # Tensor y x) -> Double
determinant = Matrix (Dimension y) (Dimension y) Double -> Double
forall (n :: Nat) x. (KnownNat n, Field x) => Matrix n n x -> x
S.determinant (Matrix (Dimension y) (Dimension y) Double -> Double)
-> ((c # Tensor y x) -> Matrix (Dimension y) (Dimension y) Double)
-> (c # Tensor y x)
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # Tensor y x) -> Matrix (Dimension y) (Dimension y) Double
forall x y c.
(Manifold x, Manifold y) =>
(c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
toMatrix

-- | Converts a point on a 'Tensor manifold into a Matrix.
toMatrix :: (Manifold x, Manifold y) => c # Tensor y x -> S.Matrix (Dimension y) (Dimension x) Double
{-# INLINE toMatrix #-}
toMatrix :: (c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
toMatrix (Point Vector (Dimension (Tensor y x)) Double
xs) = Vector Vector (Dimension y * Dimension x) Double
-> Matrix (Dimension y) (Dimension x) Double
forall (v :: Type -> Type) (m :: Nat) (n :: Nat) a.
Vector v (m * n) a -> Matrix v m n a
G.Matrix Vector Vector (Dimension y * Dimension x) Double
Vector (Dimension (Tensor y x)) Double
xs

-- | Converts a point on a 'Tensor' manifold into a a vector of rows.
toRows :: (Manifold x, Manifold y) => c # Tensor y x -> S.Vector (Dimension y) (c # x)
{-# INLINE toRows #-}
toRows :: (c # Tensor y x) -> Vector (Dimension y) (c # x)
toRows c # Tensor y x
tns = (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension y) (Vector (Dimension x) Double)
-> Vector (Dimension y) (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 (Dimension y) (Vector (Dimension x) Double)
 -> Vector (Dimension y) (c # x))
-> (Matrix (Dimension y) (Dimension x) Double
    -> Vector (Dimension y) (Vector (Dimension x) Double))
-> Matrix (Dimension y) (Dimension x) Double
-> Vector (Dimension y) (c # x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix (Dimension y) (Dimension x) Double
-> Vector (Dimension y) (Vector (Dimension x) Double)
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Storable x) =>
Matrix m n x -> Vector m (Vector n x)
S.toRows (Matrix (Dimension y) (Dimension x) Double
 -> Vector (Dimension y) (c # x))
-> Matrix (Dimension y) (Dimension x) Double
-> Vector (Dimension y) (c # x)
forall a b. (a -> b) -> a -> b
$ (c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
forall x y c.
(Manifold x, Manifold y) =>
(c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
toMatrix c # Tensor y x
tns

-- | Converts a point on a 'Tensor' manifold into a a vector of rows.
toColumns :: (Manifold x, Manifold y) => c # Tensor y x -> S.Vector (Dimension x) (c # y)
{-# INLINE toColumns #-}
toColumns :: (c # Tensor y x) -> Vector (Dimension x) (c # y)
toColumns c # Tensor y x
tns = (Vector (Dimension y) Double -> c # y)
-> Vector (Dimension x) (Vector (Dimension y) Double)
-> Vector (Dimension x) (c # y)
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map Vector (Dimension y) Double -> c # y
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) (Vector (Dimension y) Double)
 -> Vector (Dimension x) (c # y))
-> (Matrix (Dimension y) (Dimension x) Double
    -> Vector (Dimension x) (Vector (Dimension y) Double))
-> Matrix (Dimension y) (Dimension x) Double
-> Vector (Dimension x) (c # y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix (Dimension y) (Dimension x) Double
-> Vector (Dimension x) (Vector (Dimension y) Double)
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Numeric x) =>
Matrix m n x -> Vector n (Vector m x)
S.toColumns (Matrix (Dimension y) (Dimension x) Double
 -> Vector (Dimension x) (c # y))
-> Matrix (Dimension y) (Dimension x) Double
-> Vector (Dimension x) (c # y)
forall a b. (a -> b) -> a -> b
$ (c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
forall x y c.
(Manifold x, Manifold y) =>
(c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
toMatrix c # Tensor y x
tns

-- | Converts a vector of rows into a 'Tensor'.
fromRows :: (Manifold x, Manifold y) => S.Vector (Dimension y) (c # x) -> c # Tensor y x
{-# INLINE fromRows #-}
fromRows :: Vector (Dimension y) (c # x) -> c # Tensor y x
fromRows Vector (Dimension y) (c # x)
rws = Matrix Vector (Dimension y) (Dimension x) Double -> c # Tensor y x
forall y x c.
Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
fromMatrix (Matrix Vector (Dimension y) (Dimension x) Double
 -> c # Tensor y x)
-> (Vector (Dimension y) (Vector (Dimension x) Double)
    -> Matrix Vector (Dimension y) (Dimension x) Double)
-> Vector (Dimension y) (Vector (Dimension x) Double)
-> c # Tensor y x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Dimension y) (Vector (Dimension x) Double)
-> Matrix Vector (Dimension y) (Dimension x) Double
forall (n :: Nat) x (m :: Nat).
(KnownNat n, Storable x) =>
Vector m (Vector n x) -> Matrix m n x
S.fromRows (Vector (Dimension y) (Vector (Dimension x) Double)
 -> c # Tensor y x)
-> Vector (Dimension y) (Vector (Dimension x) Double)
-> c # Tensor y x
forall a b. (a -> b) -> a -> b
$ ((c # x) -> Vector (Dimension x) Double)
-> Vector (Dimension y) (c # x)
-> Vector (Dimension y) (Vector (Dimension x) Double)
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map (c # x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Vector (Dimension y) (c # x)
rws

-- | Converts a vector of rows into a 'Tensor'.
fromColumns :: (Manifold x, Manifold y) => S.Vector (Dimension x) (c # y) -> c # Tensor y x
{-# INLINE fromColumns #-}
fromColumns :: Vector (Dimension x) (c # y) -> c # Tensor y x
fromColumns Vector (Dimension x) (c # y)
rws = Matrix Vector (Dimension y) (Dimension x) Double -> c # Tensor y x
forall y x c.
Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
fromMatrix (Matrix Vector (Dimension y) (Dimension x) Double
 -> c # Tensor y x)
-> (Vector (Dimension x) (Vector (Dimension y) Double)
    -> Matrix Vector (Dimension y) (Dimension x) Double)
-> Vector (Dimension x) (Vector (Dimension y) Double)
-> c # Tensor y x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector (Dimension x) (Vector (Dimension y) Double)
-> Matrix Vector (Dimension y) (Dimension x) Double
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Numeric x) =>
Vector n (Vector m x) -> Matrix m n x
S.fromColumns (Vector (Dimension x) (Vector (Dimension y) Double)
 -> c # Tensor y x)
-> Vector (Dimension x) (Vector (Dimension y) Double)
-> c # Tensor y x
forall a b. (a -> b) -> a -> b
$ ((c # y) -> Vector (Dimension y) Double)
-> Vector (Dimension x) (c # y)
-> Vector (Dimension x) (Vector (Dimension y) Double)
forall a b (n :: Nat).
(Storable a, Storable b) =>
(a -> b) -> Vector n a -> Vector n b
S.map (c # y) -> Vector (Dimension y) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates Vector (Dimension x) (c # y)
rws

-- | Converts a Matrix into a 'Point' on a 'Tensor 'Manifold'.
fromMatrix :: S.Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
{-# INLINE fromMatrix #-}
fromMatrix :: Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
fromMatrix (G.Matrix Vector Vector (Dimension y * Dimension x) Double
xs) = Vector (Dimension (Tensor y x)) Double -> c # Tensor y x
forall c x. Vector (Dimension x) Double -> Point c x
Point Vector Vector (Dimension y * Dimension x) Double
Vector (Dimension (Tensor y x)) Double
xs


--- Affine Functions ---


-- | An 'Affine' 'Manifold' represents linear transformations followed by a
-- translation. The 'First' component is the translation, and the 'Second'
-- component is the linear transformation.
newtype Affine f y z x = Affine (z,f y x)

deriving instance (Manifold z, Manifold (f y x)) => Manifold (Affine f y z x)
deriving instance (Manifold z, Manifold (f y x)) => Product (Affine f y z x)

-- | Infix synonym for simple 'Affine' transformations.
type (y <* x) = Affine Tensor y y x
infixr 6 <*

-- | The 'Translation' class is used to define translations where we only want
-- to translate a subset of the parameters of the given object.
class (Manifold y, Manifold z) => Translation z y where
    -- | Translates the the first argument by the second argument.
    (>+>) :: c # z -> c # y -> c # z
    -- | Returns the subset of the parameters of the given 'Point' that are
    -- translated in this instance.
    anchor :: c # z -> c # y

-- | Operator that applies a 'Map' to a subset of an input's parameters.
(>.+>) :: (Map c f y x, Translation z x) => c # f y x -> c #* z -> c # y
>.+> :: (c # f y x) -> (c #* z) -> c # y
(>.+>) c # f y x
f c #* z
w = c # f y x
f (c # f y x) -> (c #* x) -> c # y
forall c (f :: Type -> Type -> Type) y x.
Map c f y x =>
(c # f y x) -> (c #* x) -> c # y
>.> (c #* z) -> c #* x
forall z y c. Translation z y => (c # z) -> c # y
anchor c #* z
w

-- | Operator that maps a 'Map' over a subset of the parameters of a list of inputs.
(>$+>) :: (Map c f y x, Translation z x) => c # f y x -> [c #* z] -> [c # y]
>$+> :: (c # f y x) -> [c #* z] -> [c # y]
(>$+>) c # f y x
f [c #* z]
w = c # f y x
f (c # f y x) -> [c #* x] -> [c # y]
forall c (f :: Type -> Type -> Type) y x.
Map c f y x =>
(c # f y x) -> [c #* x] -> [c # y]
>$> ((c #* z) -> c #* x
forall z y c. Translation z y => (c # z) -> c # y
anchor ((c #* z) -> c #* x) -> [c #* z] -> [c #* x]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [c #* z]
w)


--- Instances ---

-- Tensors --

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

instance (Manifold x, Manifold y) => Map c Tensor y x where
    {-# INLINE (>.>) #-}
    >.> :: (c # Tensor y x) -> (c #* x) -> c # y
(>.>) c # Tensor y x
pq (Point Vector (Dimension x) Double
xs) = Vector (Dimension y) Double -> c # y
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension y) Double -> c # y)
-> Vector (Dimension y) Double -> c # y
forall a b. (a -> b) -> a -> b
$ Matrix (Dimension y) (Dimension x) Double
-> Vector (Dimension x) Double -> Vector (Dimension y) Double
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Numeric x) =>
Matrix m n x -> Vector n x -> Vector m x
S.matrixVectorMultiply ((c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
forall x y c.
(Manifold x, Manifold y) =>
(c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
toMatrix c # Tensor y x
pq) Vector (Dimension x) Double
xs
    {-# INLINE (>$>) #-}
    >$> :: (c # Tensor y x) -> [c #* x] -> [c # y]
(>$>) c # Tensor y x
pq [c #* x]
qs = Vector (Dimension y) Double -> c # y
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension y) Double -> c # y)
-> [Vector (Dimension y) Double] -> [c # y]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Matrix (Dimension y) (Dimension x) Double
-> [Vector (Dimension x) Double] -> [Vector (Dimension y) Double]
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Numeric x) =>
Matrix m n x -> [Vector n x] -> [Vector m x]
S.matrixMap ((c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
forall x y c.
(Manifold x, Manifold y) =>
(c # Tensor y x) -> Matrix (Dimension y) (Dimension x) Double
toMatrix c # Tensor y x
pq) ((c #* x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates ((c #* x) -> Vector (Dimension x) Double)
-> [c #* x] -> [Vector (Dimension x) Double]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [c #* x]
qs)

instance (Manifold x, Manifold y) => Bilinear Tensor y x where
    {-# INLINE (>.<) #-}
    >.< :: (c # y) -> (c # x) -> c # Tensor y x
(>.<) (Point Vector (Dimension y) Double
pxs) (Point Vector (Dimension x) Double
qxs) = Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
forall y x c.
Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
fromMatrix (Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x)
-> Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
forall a b. (a -> b) -> a -> b
$ Vector (Dimension y) Double
pxs Vector (Dimension y) Double
-> Vector (Dimension x) Double
-> Matrix (Dimension y) (Dimension x) Double
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Numeric x) =>
Vector m x -> Vector n x -> Matrix m n x
`S.outerProduct` Vector (Dimension x) Double
qxs
    {-# INLINE (>$<) #-}
    >$< :: [c # y] -> [c # x] -> c # Tensor y x
(>$<) [c # y]
ps [c # x]
qs = Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
forall y x c.
Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
fromMatrix (Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x)
-> ([(Vector (Dimension y) Double, Vector (Dimension x) Double)]
    -> Matrix (Dimension y) (Dimension x) Double)
-> [(Vector (Dimension y) Double, Vector (Dimension x) Double)]
-> c # Tensor y x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Vector (Dimension y) Double, Vector (Dimension x) Double)]
-> Matrix (Dimension y) (Dimension x) Double
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Fractional x, Numeric x) =>
[(Vector m x, Vector n x)] -> Matrix m n x
S.averageOuterProduct ([(Vector (Dimension y) Double, Vector (Dimension x) Double)]
 -> c # Tensor y x)
-> [(Vector (Dimension y) Double, Vector (Dimension x) Double)]
-> c # Tensor y x
forall a b. (a -> b) -> a -> b
$ [Vector (Dimension y) Double]
-> [Vector (Dimension x) Double]
-> [(Vector (Dimension y) Double, Vector (Dimension x) Double)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((c # y) -> Vector (Dimension y) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates ((c # y) -> Vector (Dimension y) Double)
-> [c # y] -> [Vector (Dimension y) Double]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [c # y]
ps) ((c # x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates ((c # x) -> Vector (Dimension x) Double)
-> [c # x] -> [Vector (Dimension x) Double]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [c # x]
qs)
    {-# INLINE transpose #-}
    transpose :: (c # Tensor y x) -> c # Tensor x y
transpose (Point Vector (Dimension (Tensor y x)) Double
xs) = Matrix Vector (Dimension x) (Dimension y) Double -> c # Tensor x y
forall y x c.
Matrix (Dimension y) (Dimension x) Double -> c # Tensor y x
fromMatrix (Matrix Vector (Dimension x) (Dimension y) Double
 -> c # Tensor x y)
-> (Matrix (Dimension y) (Dimension x) Double
    -> Matrix Vector (Dimension x) (Dimension y) Double)
-> Matrix (Dimension y) (Dimension x) Double
-> c # Tensor x y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Matrix (Dimension y) (Dimension x) Double
-> Matrix Vector (Dimension x) (Dimension y) Double
forall (m :: Nat) (n :: Nat) x.
(KnownNat m, KnownNat n, Numeric x) =>
Matrix m n x -> Matrix n m x
S.transpose (Matrix (Dimension y) (Dimension x) Double -> c # Tensor x y)
-> Matrix (Dimension y) (Dimension x) Double -> c # Tensor x y
forall a b. (a -> b) -> a -> b
$ Vector Vector (Dimension y * Dimension x) Double
-> Matrix (Dimension y) (Dimension x) Double
forall (v :: Type -> Type) (m :: Nat) (n :: Nat) a.
Vector v (m * n) a -> Matrix v m n a
G.Matrix Vector Vector (Dimension y * Dimension x) Double
Vector (Dimension (Tensor y x)) Double
xs


-- Affine Maps --

instance Manifold z => Translation z z where
    >+> :: (c # z) -> (c # z) -> c # z
(>+>) c # z
z1 c # z
z2 = c # z
z1 (c # z) -> (c # z) -> c # z
forall a. Num a => a -> a -> a
+ c # z
z2
    anchor :: (c # z) -> c # z
anchor = (c # z) -> c # z
forall a. a -> a
id

instance (Manifold z, Manifold y) => Translation (y,z) y where
    >+> :: (c # (y, z)) -> (c # y) -> c # (y, z)
(>+>) c # (y, z)
yz c # y
y' =
        let (c # y
y,c # z
z) = (c # (y, z)) -> (c # First (y, z), c # Second (y, z))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # (y, z)
yz
         in (c # First (y, z)) -> (c # Second (y, z)) -> c # (y, z)
forall z c. Product z => (c # First z) -> (c # Second z) -> c # z
join (c # y
y (c # y) -> (c # y) -> c # y
forall a. Num a => a -> a -> a
+ c # y
y') c # z
c # Second (y, z)
z
    anchor :: (c # (y, z)) -> c # y
anchor = (c # y, c # z) -> c # y
forall a b. (a, b) -> a
fst ((c # y, c # z) -> c # y)
-> ((c # (y, z)) -> (c # y, c # z)) -> (c # (y, z)) -> c # y
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c # (y, z)) -> (c # y, c # z)
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split

instance (Translation z y, Map c f y x) => Map c (Affine f y) z x where
    {-# INLINE (>.>) #-}
    >.> :: (c # Affine f y z x) -> (c #* x) -> c # z
(>.>) c # Affine f y z x
fyzx c #* x
x =
        let (c # z
yz,c # f y x
yx) = (c # Affine f y z x)
-> (c # First (Affine f y z x), c # Second (Affine f y z x))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # Affine f y z x
fyzx
         in   c # z
yz (c # z) -> (c # y) -> c # z
forall z y c. Translation z y => (c # z) -> (c # y) -> c # z
>+> (c # f y x
yx (c # f y x) -> (c #* x) -> c # y
forall c (f :: Type -> Type -> Type) y x.
Map c f y x =>
(c # f y x) -> (c #* x) -> c # y
>.> c #* x
x)
    >$> :: (c # Affine f y z x) -> [c #* x] -> [c # z]
(>$>) c # Affine f y z x
fyzx [c #* x]
xs =
        let (c # z
yz,c # f y x
yx) = (c # Affine f y z x)
-> (c # First (Affine f y z x), c # Second (Affine f y z x))
forall z c. Product z => (c # z) -> (c # First z, c # Second z)
split c # Affine f y z x
fyzx
         in (c # z
yz (c # z) -> (c # y) -> c # z
forall z y c. Translation z y => (c # z) -> (c # y) -> c # z
>+>) ((c # y) -> c # z) -> [c # y] -> [c # z]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> c # f y x
yx (c # f y x) -> [c #* x] -> [c # y]
forall c (f :: Type -> Type -> Type) y x.
Map c f y x =>
(c # f y x) -> [c #* x] -> [c # y]
>$> [c #* x]
xs

--instance (KnownNat n, Translation w z)
--  => Translation (Replicated n w) (Replicated n z) where
--      {-# INLINE (>+>) #-}
--      (>+>) w z =
--          let ws = splitReplicated w
--              zs = splitReplicated z
--           in joinReplicated $ S.zipWith (>+>) ws zs
--      {-# INLINE anchor #-}
--      anchor = mapReplicatedPoint anchor


--instance (Map c f z x) => Map c (Affine f z) z x where
--    {-# INLINE (>.>) #-}
--    (>.>) ppq q =
--        let (p,pq) = split ppq
--         in p + pq >.> q
--    {-# INLINE (>$>) #-}
--    (>$>) ppq qs =
--        let (p,pq) = split ppq
--         in (p +) <$> (pq >$> qs)