{-# LANGUAGE UndecidableSuperClasses #-}
-- | The Linear module provides the tools for treating a locally Euclidean patch
-- of a manifold as a linear space.
module Goal.Geometry.Vector
    ( -- * Vector Spaces
      (.>)
    , (/>)
    , convexCombination
    -- * Dual Spaces
    , Primal (Dual)
    , type (#*)
    , (<.>)
    , dotMap
    ) where

--- Imports ---

-- Package --

import Goal.Core
import Goal.Geometry.Manifold

import qualified Goal.Core.Vector.Storable as S

--- Vector Spaces on Manifolds ---


-- | Scalar multiplication of points on a manifold.
(.>) :: Double -> c # x -> c # x
{-# INLINE (.>) #-}
.> :: Double -> (c # x) -> c # x
(.>) Double
a (Point Vector (Dimension x) Double
xs) = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension x) Double -> c # x
forall a b. (a -> b) -> a -> b
$ Double
-> Vector (Dimension x) Double -> Vector (Dimension x) Double
forall x (n :: Nat). Numeric x => x -> Vector n x -> Vector n x
S.scale Double
a Vector (Dimension x) Double
xs
infix 7 .>

-- | Scalar division of points on a manifold.
(/>) :: Double -> c # x -> c # x
{-# INLINE (/>) #-}
/> :: Double -> (c # x) -> c # x
(/>) Double
a (Point Vector (Dimension x) Double
xs) = Vector (Dimension x) Double -> c # x
forall c x. Vector (Dimension x) Double -> Point c x
Point (Vector (Dimension x) Double -> c # x)
-> Vector (Dimension x) Double -> c # x
forall a b. (a -> b) -> a -> b
$ Double
-> Vector (Dimension x) Double -> Vector (Dimension x) Double
forall x (n :: Nat). Numeric x => x -> Vector n x -> Vector n x
S.scale (Double -> Double
forall a. Fractional a => a -> a
recip Double
a) Vector (Dimension x) Double
xs
infix 7 />

-- | Combination of two 'Point's. Takes the first argument of the second
-- argument, and (1-first argument) of the third argument.
convexCombination :: Manifold x => Double -> c # x -> c # x -> c # x
convexCombination :: Double -> (c # x) -> (c # x) -> c # x
convexCombination Double
x c # x
p1 c # x
p2 = Double
x Double -> (c # x) -> c # x
forall c x. Double -> (c # x) -> c # x
.> c # x
p1 (c # x) -> (c # x) -> c # x
forall a. Num a => a -> a -> a
+ (Double
1Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
x) Double -> (c # x) -> c # x
forall c x. Double -> (c # x) -> c # x
.> c # x
p2


--- Dual Spaces ---


-- | 'Primal' charts have a 'Dual' coordinate system.
class (Dual (Dual c) ~ c, Primal (Dual c)) => Primal c where
    type Dual c :: Type

-- | A 'Point' on a 'Manifold' in the 'Dual' coordinates of c.
type (c #* x) = Point (Dual c) x
infix 3 #*

-- | '<.>' is the inner product between a dual pair of 'Point's.
(<.>) :: c # x -> c #* x -> Double
{-# INLINE (<.>) #-}
<.> :: (c # x) -> (c #* x) -> Double
(<.>) c # x
p c #* x
q = Vector (Dimension x) Double
-> Vector (Dimension x) Double -> Double
forall x (n :: Nat). Numeric x => Vector n x -> Vector n x -> x
S.dotProduct ((c # x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates c # x
p) ((c #* x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates c #* x
q)

infix 7 <.>

-- | 'dotMap' computes the inner product over a list of dual elements.
dotMap :: Manifold x => c # x -> [c #* x] -> [Double]
{-# INLINE dotMap #-}
dotMap :: (c # x) -> [c #* x] -> [Double]
dotMap c # x
p [c #* x]
qs = Vector (Dimension x) Double
-> [Vector (Dimension x) Double] -> [Double]
forall (n :: Nat) x.
(KnownNat n, Numeric x) =>
Vector n x -> [Vector n x] -> [x]
S.dotMap ((c # x) -> Vector (Dimension x) Double
forall c x. Point c x -> Vector (Dimension x) Double
coordinates c # x
p) ((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)

-- Cartesian Spaces --

instance Primal Cartesian where
    type Dual Cartesian = Cartesian