{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{- |
This module is not yet exported
since its interface is not mature.
There are two approaches for representing affine spaces:

[1] Two sets: A set of points and a set of vectors.
    Examples: Absolute potential and voltage,
    absolute temperature and temperature difference.
    Operations are
      add :: vector -> point -> point
      sub :: point -> point -> vector

[2] One set for points, no vectors.
    Examples: Interpolation
    Operation:
      combine :: [(coefficient, vector)] -> vector
    Where it must be asserted,
    that the coefficients sum up to 1.

The second one is the one we follow here.
It is more similar to Module and VectorSpace.
-}
module Algebra.AffineSpace where

import qualified Algebra.PrincipalIdealDomain as PID
import qualified Algebra.Additive as Additive
import qualified Algebra.Module as Module
import qualified Number.Ratio as Ratio

import qualified Number.Complex as Complex

import Control.Applicative (Applicative(pure, (<*>)), )

import NumericPrelude.Numeric hiding (zero, )
import NumericPrelude.Base
import Prelude ()

{- |
The type class is for representing affine spaces via affine combinations.
However, we didn't find a way to both ensure the property
that the combination coefficients sum up to 1,
and keep it efficient.

We propose this class instead of a combination of Additive and Module
for interpolation for those types,
where scaling and addition alone makes no sense.
Such types are e.g. internal filter parameters in signal processing:
For these types interpolation makes definitely sense,
but addition and scaling make not.

That is, both classes are isomorphic
(you can define one in terms of the other),
but instances of this class are more easily defined,
and using an AffineSpace constraint instead of Module in a type signature
is important for documentation purposes.
AffineSpace should be superclass of Module.
(But then you may ask, why not adding another superclass for Convex spaces.
This class would provide a linear combination operation,
where the coefficients sum up to one
and all of them are non-negative.)

We may add a safety layer that ensures
that the coefficients sum up to 1,
using start points on the simplex
and functions to move on the simplex.
Start points have components that sum up to 1, e.g.

> (1, 0, 0, 0)
> (0, 1, 0, 0)
> (0, 0, 1, 0)
> (0, 0, 0, 1)
> (1/4, 1/4, 1/4, 1/4)

Then you may move along the simplex in the directions

> (1,  -1, 0,  0)
> (0,   1, 0, -1)
> (-1, -1, 3, -1)

which are characterized by components that sum up to 0.

For example linear combination is defined by

> lerp k (a,b) = (1-k)*>a + k*>b

that is the coefficients are (1-k) and k.
The pair (1-k, k) can be constructed
by starting at pair (1,0)
and moving k units in direction (-1,1).

> (1-k, k) = (1,0) + k*(-1,1)

It is however a challenge to manage the coefficient tuples
in a type safe and efficient way.
For small numbers of interpolation nodes
(constant, linear, cubic interpolation)
a type level list would appropriate,
but what to do for large tuples
like for Whittaker interpolation?


As side note:
In principle it would be sufficient
to provide an affine combination of two points,
since all affine combinations of more points
can be decomposed into such simple combinations.

> lerp a x y = (1-a)*>x + a*>y

E.g. @a*>x + b*>y + c*>z@ with @a+b+c=1@
can be written as @lerp c (lerp (b/(1-c)) x y) z@.
More generally you can use

> lerpnorm a b x y
>    = lerp (b/(a+b)) x y
>    = (a/(a+b))*>x + (b/(a+b))*>y

for writing

> a*>x + b*>y + c*>z ==
>    lerpnorm (a+b) c (lerpnorm a b x y) z

or

> a*>x + b*>y + c*>z + d*>w ==
>    lerpnorm (a+b+c) d (lerpnorm (a+b) c (lerpnorm a b x y) z) w

with @a+b+c+d=1@.

The downside is, that lerpnorm requires division, that is, a field,
whereas the computation of the coefficients
sometimes only requires ring operations.
-}
class Zero v => C a v where
   multiplyAccumulate :: (a,v) -> v -> v

class Zero v where
   zero :: v


instance Zero Float where
   {-# INLINE zero #-}
   zero :: Float
zero = Float
forall a. C a => a
Additive.zero

instance Zero Double where
   {-# INLINE zero #-}
   zero :: Double
zero = Double
forall a. C a => a
Additive.zero

instance (Zero a) => Zero (Complex.T a) where
   {-# INLINE zero #-}
   zero :: T a
zero = a
forall v. Zero v => v
zero a -> a -> T a
forall a. a -> a -> T a
Complex.+: a
forall v. Zero v => v
zero

instance (PID.C a) => Zero (Ratio.T a) where
   {-# INLINE zero #-}
   zero :: T a
zero = T a
forall a. C a => a
Additive.zero


instance C Float Float where
   {-# INLINE multiplyAccumulate #-}
   multiplyAccumulate :: (Float, Float) -> Float -> Float
multiplyAccumulate (Float
a,Float
x) Float
y = Float
aFloat -> Float -> Float
forall a. C a => a -> a -> a
*Float
xFloat -> Float -> Float
forall a. C a => a -> a -> a
+Float
y

instance C Double Double where
   {-# INLINE multiplyAccumulate #-}
   multiplyAccumulate :: (Double, Double) -> Double -> Double
multiplyAccumulate (Double
a,Double
x) Double
y = Double
aDouble -> Double -> Double
forall a. C a => a -> a -> a
*Double
xDouble -> Double -> Double
forall a. C a => a -> a -> a
+Double
y

instance (C a v) => C a (Complex.T v) where
   {-# INLINE multiplyAccumulate #-}
   multiplyAccumulate :: (a, T v) -> T v -> T v
multiplyAccumulate =
      (v -> v -> T v)
-> (T v -> v) -> (T v -> v) -> (a, T v) -> T v -> T v
forall a x y v.
(C a x, C a y) =>
(x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> v -> v
makeMac2 v -> v -> T v
forall a. a -> a -> T a
(Complex.+:) T v -> v
forall a. T a -> a
Complex.real T v -> v
forall a. T a -> a
Complex.imag

instance (PID.C a) => C (Ratio.T a) (Ratio.T a) where
   {-# INLINE multiplyAccumulate #-}
   multiplyAccumulate :: (T a, T a) -> T a -> T a
multiplyAccumulate (T a
a,T a
x) T a
y = T a
aT a -> T a -> T a
forall a. C a => a -> a -> a
*T a
xT a -> T a -> T a
forall a. C a => a -> a -> a
+T a
y


infixl 6 *.+

{- |
Infix variant of 'multiplyAccumulate'.
-}
{-# INLINE (*.+) #-}
(*.+) :: C a v => v -> (a,v) -> v
*.+ :: v -> (a, v) -> v
(*.+) = ((a, v) -> v -> v) -> v -> (a, v) -> v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a, v) -> v -> v
forall a v. C a v => (a, v) -> v -> v
multiplyAccumulate


-- * convenience functions for defining multiplyAccumulate

{-# INLINE multiplyAccumulateModule #-}
multiplyAccumulateModule ::
   Module.C a v =>
   (a,v) -> v -> v
multiplyAccumulateModule :: (a, v) -> v -> v
multiplyAccumulateModule (a
a,v
x) v
y =
   a
a a -> v -> v
forall a v. C a v => a -> v -> v
*> v
x v -> v -> v
forall a. C a => a -> a -> a
+ v
y


{- |
A special reader monad.
-}
newtype MAC a v x = MAC {MAC a v x -> (a, v) -> v -> x
runMac :: (a,v) -> v -> x}

{-# INLINE element #-}
element ::
   (C a x) =>
   (v -> x) -> MAC a v x
element :: (v -> x) -> MAC a v x
element v -> x
f =
   ((a, v) -> v -> x) -> MAC a v x
forall a v x. ((a, v) -> v -> x) -> MAC a v x
MAC (\(a
a,v
x) v
y -> (a, x) -> x -> x
forall a v. C a v => (a, v) -> v -> v
multiplyAccumulate (a
a, v -> x
f v
x) (v -> x
f v
y))

instance Functor (MAC a v) where
   {-# INLINE fmap #-}
   fmap :: (a -> b) -> MAC a v a -> MAC a v b
fmap a -> b
f (MAC (a, v) -> v -> a
x) =
      ((a, v) -> v -> b) -> MAC a v b
forall a v x. ((a, v) -> v -> x) -> MAC a v x
MAC (((a, v) -> v -> b) -> MAC a v b)
-> ((a, v) -> v -> b) -> MAC a v b
forall a b. (a -> b) -> a -> b
$ \(a, v)
av v
v -> a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ (a, v) -> v -> a
x (a, v)
av v
v

instance Applicative (MAC a v) where
   {-# INLINE pure #-}
   {-# INLINE (<*>) #-}
   pure :: a -> MAC a v a
pure a
x = ((a, v) -> v -> a) -> MAC a v a
forall a v x. ((a, v) -> v -> x) -> MAC a v x
MAC (((a, v) -> v -> a) -> MAC a v a)
-> ((a, v) -> v -> a) -> MAC a v a
forall a b. (a -> b) -> a -> b
$ \ (a, v)
_av v
_v -> a
x
   MAC (a, v) -> v -> a -> b
f <*> :: MAC a v (a -> b) -> MAC a v a -> MAC a v b
<*> MAC (a, v) -> v -> a
x =
      ((a, v) -> v -> b) -> MAC a v b
forall a v x. ((a, v) -> v -> x) -> MAC a v x
MAC (((a, v) -> v -> b) -> MAC a v b)
-> ((a, v) -> v -> b) -> MAC a v b
forall a b. (a -> b) -> a -> b
$ \(a, v)
av v
v -> (a, v) -> v -> a -> b
f (a, v)
av v
v (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ (a, v) -> v -> a
x (a, v)
av v
v

{-# INLINE makeMac #-}
makeMac ::
   (C a x) =>
   (x -> v) ->
   (v -> x) ->
   (a,v) -> v -> v
makeMac :: (x -> v) -> (v -> x) -> (a, v) -> v -> v
makeMac x -> v
cons v -> x
x =
   MAC a v v -> (a, v) -> v -> v
forall a v x. MAC a v x -> (a, v) -> v -> x
runMac (MAC a v v -> (a, v) -> v -> v) -> MAC a v v -> (a, v) -> v -> v
forall a b. (a -> b) -> a -> b
$ (x -> v) -> MAC a v (x -> v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure x -> v
cons MAC a v (x -> v) -> MAC a v x -> MAC a v v
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> x) -> MAC a v x
forall a x v. C a x => (v -> x) -> MAC a v x
element v -> x
x

{-# INLINE makeMac2 #-}
makeMac2 ::
   (C a x, C a y) =>
   (x -> y -> v) ->
   (v -> x) -> (v -> y) ->
   (a,v) -> v -> v
makeMac2 :: (x -> y -> v) -> (v -> x) -> (v -> y) -> (a, v) -> v -> v
makeMac2 x -> y -> v
cons v -> x
x v -> y
y =
   MAC a v v -> (a, v) -> v -> v
forall a v x. MAC a v x -> (a, v) -> v -> x
runMac (MAC a v v -> (a, v) -> v -> v) -> MAC a v v -> (a, v) -> v -> v
forall a b. (a -> b) -> a -> b
$ (x -> y -> v) -> MAC a v (x -> y -> v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure x -> y -> v
cons MAC a v (x -> y -> v) -> MAC a v x -> MAC a v (y -> v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> x) -> MAC a v x
forall a x v. C a x => (v -> x) -> MAC a v x
element v -> x
x MAC a v (y -> v) -> MAC a v y -> MAC a v v
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> y) -> MAC a v y
forall a x v. C a x => (v -> x) -> MAC a v x
element v -> y
y

{-# INLINE makeMac3 #-}
makeMac3 ::
   (C a x, C a y, C a z) =>
   (x -> y -> z -> v) ->
   (v -> x) -> (v -> y) -> (v -> z) ->
   (a,v) -> v -> v
makeMac3 :: (x -> y -> z -> v)
-> (v -> x) -> (v -> y) -> (v -> z) -> (a, v) -> v -> v
makeMac3 x -> y -> z -> v
cons v -> x
x v -> y
y v -> z
z =
   MAC a v v -> (a, v) -> v -> v
forall a v x. MAC a v x -> (a, v) -> v -> x
runMac (MAC a v v -> (a, v) -> v -> v) -> MAC a v v -> (a, v) -> v -> v
forall a b. (a -> b) -> a -> b
$ (x -> y -> z -> v) -> MAC a v (x -> y -> z -> v)
forall (f :: * -> *) a. Applicative f => a -> f a
pure x -> y -> z -> v
cons MAC a v (x -> y -> z -> v) -> MAC a v x -> MAC a v (y -> z -> v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> x) -> MAC a v x
forall a x v. C a x => (v -> x) -> MAC a v x
element v -> x
x MAC a v (y -> z -> v) -> MAC a v y -> MAC a v (z -> v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> y) -> MAC a v y
forall a x v. C a x => (v -> x) -> MAC a v x
element v -> y
y MAC a v (z -> v) -> MAC a v z -> MAC a v v
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (v -> z) -> MAC a v z
forall a x v. C a x => (v -> x) -> MAC a v x
element v -> z
z