-- | Tools are also provided for convex analysis, as the dual structures of
-- convex analysis are equivalent to Riemannian manifolds with certain
-- properties.
module Goal.Geometry.Differential.Convex where


--- Imports ---


-- Goal --

import Goal.Geometry.Set
import Goal.Geometry.Manifold
import Goal.Geometry.Linear
import Goal.Geometry.Differential

--- Dually Flat Manifolds ---

-- | Although convex analysis is usually developed seperately from differential
-- geometry, it arrises naturally out of the theory of dually flat 'Manifold's.
--
-- A 'Manifold' is 'Legendre' for a particular coordinated system if it is
-- associated with a particular convex function on points of the manifold known
-- as a 'potential'.
class (Primal c, Manifold m) => Legendre c m where
    potential :: (c :#: m) -> Double
    potentialDifferentials :: (c :#: m) -> Differentials :#: Tangent c m

potentialMapping :: Legendre c m => (c :#: m) -> Dual c :#: m
potentialMapping p = fromCoordinates (manifold p) . coordinates $ potentialDifferentials p

-- | Computes the 'divergence' between two points.
divergence :: (Primal c, Legendre c m, Legendre (Dual c) m) => (c :#: m) -> (Dual c :#: m) -> Double
divergence pp dq = potential pp + potential dq - (pp <.> dq)

legendreFlat :: (Legendre c m, Riemannian c m) => c :#: m -> c :#: m -> Dual c :#: m
-- | Applies 'flat' to the second input, based on the tangent space at the first input.
legendreFlat mp err = fromCoordinates (manifold mp) . coordinates . flat . fromCoordinates (Tangent mp) $ coordinates err


--- Instances ---


-- Generic --

-- Direct Sums --

instance Legendre c m => Legendre c (Replicated m) where
    potential ps = sum $ mapReplicated potential ps
    potentialDifferentials ps =
        let dps = mapReplicated potentialDifferentials ps
        in fromCoordinates (Tangent ps) . coordinates $ joinReplicated dps