{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, TypeFamilies, CPP #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE DefaultSignatures   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators       #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveGeneric        #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.AffineSpace
-- Copyright   :  (c) Conal Elliott and Andy J Gill 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net, andygill@ku.edu
-- Stability   :  experimental
-- 
-- Affine spaces.
----------------------------------------------------------------------

module Data.AffineSpace
  (
    AffineSpace(..), (.-^), distanceSq, distance, alerp, affineCombo
  ) where

import Control.Applicative (liftA2)
import Data.Ratio
import Foreign.C.Types (CSChar, CInt, CShort, CLong, CLLong, CIntMax, CFloat, CDouble)
import Control.Arrow(first)

import Data.VectorSpace
import Data.Basis

import Data.VectorSpace.Generic
import qualified GHC.Generics as Gnrx
import GHC.Generics (Generic, (:*:)(..))

-- Through 0.8.4, I used the following fixities.
-- 
--   infix 4 .+^, .-^, .-.
-- 
-- Changed in 0.8.5 to match precedence of + and -, and to associate usefully.
-- Thanks to Ben Gamari for suggesting left-associativity.

infixl 6 .+^, .-^
infix  6 .-.


-- TODO: Convert AffineSpace from fundep to associated type, and eliminate
-- FunctionalDependencies above.

class AdditiveGroup (Diff p) => AffineSpace p where
  -- | Associated vector space
  type Diff p
  type Diff p = GenericDiff p
  -- | Subtract points
  (.-.)  :: p -> p -> Diff p
  default (.-.) :: ( Generic p, Diff p ~ GenericDiff p, AffineSpace (VRep p) )
              => p -> p -> Diff p
  p
p .-. p
q = forall p. Diff (VRep p) -> GenericDiff p
GenericDiff
         forall a b. (a -> b) -> a -> b
$ (forall a x. Generic a => a -> Rep a x
Gnrx.from p
p forall p. AffineSpace p => p -> p -> Diff p
.-. (forall a x. Generic a => a -> Rep a x
Gnrx.from p
q :: VRep p))
  -- | Point plus vector
  (.+^)  :: p -> Diff p -> p
  default (.+^) :: ( Generic p, Diff p ~ GenericDiff p, AffineSpace (VRep p) )
              => p -> Diff p -> p
  p
p .+^ GenericDiff Diff (VRep p)
q = forall a x. Generic a => Rep a x -> a
Gnrx.to (forall a x. Generic a => a -> Rep a x
Gnrx.from p
p forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff (VRep p)
q :: VRep p)

-- | Point minus vector
(.-^) :: AffineSpace p => p -> Diff p -> p
p
p .-^ :: forall p. AffineSpace p => p -> Diff p -> p
.-^ Diff p
v = p
p forall p. AffineSpace p => p -> Diff p -> p
.+^ forall v. AdditiveGroup v => v -> v
negateV Diff p
v

-- | Square of the distance between two points.  Sometimes useful for
-- efficiency.  See also 'distance'.
distanceSq :: (AffineSpace p, v ~ Diff p, InnerSpace v) =>
              p -> p -> Scalar v
distanceSq :: forall p v.
(AffineSpace p, v ~ Diff p, InnerSpace v) =>
p -> p -> Scalar v
distanceSq = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall v s. (InnerSpace v, s ~ Scalar v) => v -> s
magnitudeSq forall p. AffineSpace p => p -> p -> Diff p
(.-.)

-- | Distance between two points.  See also 'distanceSq'.
distance :: (AffineSpace p, v ~ Diff p, InnerSpace v
            , s ~ Scalar v, Floating (Scalar v))
         => p -> p -> s
distance :: forall p v s.
(AffineSpace p, v ~ Diff p, InnerSpace v, s ~ Scalar v,
 Floating (Scalar v)) =>
p -> p -> s
distance = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmapforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) forall a. Floating a => a -> a
sqrt forall p v.
(AffineSpace p, v ~ Diff p, InnerSpace v) =>
p -> p -> Scalar v
distanceSq

-- | Affine linear interpolation.  Varies from @p@ to @p'@ as @s@ varies
-- from 0 to 1.  See also 'lerp' (on vector spaces).
alerp :: (AffineSpace p, VectorSpace (Diff p)) =>
         p -> p -> Scalar (Diff p) -> p
alerp :: forall p.
(AffineSpace p, VectorSpace (Diff p)) =>
p -> p -> Scalar (Diff p) -> p
alerp p
p p
p' Scalar (Diff p)
s = p
p forall p. AffineSpace p => p -> Diff p -> p
.+^ (Scalar (Diff p)
s forall v. VectorSpace v => Scalar v -> v -> v
*^ (p
p' forall p. AffineSpace p => p -> p -> Diff p
.-. p
p))

-- | Compute an affine combination (weighted average) of points.
-- The first element is used as origin and is weighted
-- such that all coefficients sum to 1. For example,
--
-- > affineCombo a [(0.3,b), (0.2,c)]
--
-- is equal to
--
-- > a .+^ (0.3 *^ (b .-. a) ^+^ 0.2 *^ (c .-. a))
--
-- and if @a@, @b@, and @c@ were in a vector space would also be equal to
--
-- > 0.5 *^ a ^+^ 0.3 *^ b ^+^ 0.2 *^ c
--
-- See also 'linearCombo' (on vector spaces).
affineCombo :: (AffineSpace p, v ~ Diff p, VectorSpace v) => p -> [(p,Scalar v)] -> p
affineCombo :: forall p v.
(AffineSpace p, v ~ Diff p, VectorSpace v) =>
p -> [(p, Scalar v)] -> p
affineCombo p
z [(p, Scalar v)]
l = p
z forall p. AffineSpace p => p -> Diff p -> p
.+^ forall v. VectorSpace v => [(v, Scalar v)] -> v
linearCombo (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall p. AffineSpace p => p -> p -> Diff p
.-. p
z)) [(p, Scalar v)]
l)

#define ScalarTypeCon(con,t) \
  instance con => AffineSpace (t) where \
    { type Diff (t) = t \
    ; (.-.) = (-) \
    ; (.+^) = (+) }

#define ScalarType(t) ScalarTypeCon((),t)

ScalarType(Int)
ScalarType(Integer)
ScalarType(Double)
ScalarType(Float)
ScalarType(CSChar)
ScalarType(CInt)
ScalarType(CShort)
ScalarType(CLong)
ScalarType(CLLong)
ScalarType(CIntMax)
ScalarType(CDouble)
ScalarType(CFloat)
ScalarTypeCon(Integral a,Ratio a)

instance (AffineSpace p, AffineSpace q) => AffineSpace (p,q) where
  type Diff (p,q)   = (Diff p, Diff q)
  (p
p,q
q) .-. :: (p, q) -> (p, q) -> Diff (p, q)
.-. (p
p',q
q') = (p
p forall p. AffineSpace p => p -> p -> Diff p
.-. p
p', q
q forall p. AffineSpace p => p -> p -> Diff p
.-. q
q')
  (p
p,q
q) .+^ :: (p, q) -> Diff (p, q) -> (p, q)
.+^ (Diff p
u,Diff q
v)   = (p
p forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff p
u, q
q forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff q
v)

instance (AffineSpace p, AffineSpace q, AffineSpace r) => AffineSpace (p,q,r) where
  type Diff (p,q,r)      = (Diff p, Diff q, Diff r)
  (p
p,q
q,r
r) .-. :: (p, q, r) -> (p, q, r) -> Diff (p, q, r)
.-. (p
p',q
q',r
r') = (p
p forall p. AffineSpace p => p -> p -> Diff p
.-. p
p', q
q forall p. AffineSpace p => p -> p -> Diff p
.-. q
q', r
r forall p. AffineSpace p => p -> p -> Diff p
.-. r
r')
  (p
p,q
q,r
r) .+^ :: (p, q, r) -> Diff (p, q, r) -> (p, q, r)
.+^ (Diff p
u,Diff q
v,Diff r
w)    = (p
p forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff p
u, q
q forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff q
v, r
r forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff r
w)


instance (AffineSpace p) => AffineSpace (a -> p) where
  type Diff (a -> p) = a -> Diff p
  .-. :: (a -> p) -> (a -> p) -> Diff (a -> p)
(.-.)              = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall p. AffineSpace p => p -> p -> Diff p
(.-.)
  .+^ :: (a -> p) -> Diff (a -> p) -> a -> p
(.+^)              = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall p. AffineSpace p => p -> Diff p -> p
(.+^)



newtype GenericDiff p = GenericDiff (Diff (VRep p))
       deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (GenericDiff p) x -> GenericDiff p
forall p x. GenericDiff p -> Rep (GenericDiff p) x
$cto :: forall p x. Rep (GenericDiff p) x -> GenericDiff p
$cfrom :: forall p x. GenericDiff p -> Rep (GenericDiff p) x
Generic)

instance AdditiveGroup (Diff (VRep p)) => AdditiveGroup (GenericDiff p)
instance VectorSpace (Diff (VRep p)) => VectorSpace (GenericDiff p)
instance InnerSpace (Diff (VRep p)) => InnerSpace (GenericDiff p)
instance HasBasis (Diff (VRep p)) => HasBasis (GenericDiff p)

data AffineDiffProductSpace f g p = AffineDiffProductSpace
            !(Diff (f p)) !(Diff (g p)) deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) (g :: * -> *) p x.
Rep (AffineDiffProductSpace f g p) x
-> AffineDiffProductSpace f g p
forall (f :: * -> *) (g :: * -> *) p x.
AffineDiffProductSpace f g p
-> Rep (AffineDiffProductSpace f g p) x
$cto :: forall (f :: * -> *) (g :: * -> *) p x.
Rep (AffineDiffProductSpace f g p) x
-> AffineDiffProductSpace f g p
$cfrom :: forall (f :: * -> *) (g :: * -> *) p x.
AffineDiffProductSpace f g p
-> Rep (AffineDiffProductSpace f g p) x
Generic)
instance (AffineSpace (f p), AffineSpace (g p))
    => AdditiveGroup (AffineDiffProductSpace f g p)
instance ( AffineSpace (f p), AffineSpace (g p)
         , VectorSpace (Diff (f p)), VectorSpace (Diff (g p))
         , Scalar (Diff (f p)) ~ Scalar (Diff (g p)) )
    => VectorSpace (AffineDiffProductSpace f g p)
instance ( AffineSpace (f p), AffineSpace (g p)
         , InnerSpace (Diff (f p)), InnerSpace (Diff (g p))
         , Scalar (Diff (f p)) ~ Scalar (Diff (g p))
         , Num (Scalar (Diff (f p))) )
    => InnerSpace (AffineDiffProductSpace f g p)
instance (AffineSpace (f p), AffineSpace (g p))
    => AffineSpace (AffineDiffProductSpace f g p) where
  type Diff (AffineDiffProductSpace f g p) = AffineDiffProductSpace f g p
  .+^ :: AffineDiffProductSpace f g p
-> Diff (AffineDiffProductSpace f g p)
-> AffineDiffProductSpace f g p
(.+^) = forall v. AdditiveGroup v => v -> v -> v
(^+^)
  .-. :: AffineDiffProductSpace f g p
-> AffineDiffProductSpace f g p
-> Diff (AffineDiffProductSpace f g p)
(.-.) = forall v. AdditiveGroup v => v -> v -> v
(^-^)
instance ( AffineSpace (f p), AffineSpace (g p)
         , HasBasis (Diff (f p)), HasBasis (Diff (g p))
         , Scalar (Diff (f p)) ~ Scalar (Diff (g p)) )
    => HasBasis (AffineDiffProductSpace f g p) where
  type Basis (AffineDiffProductSpace f g p) = Either (Basis (Diff (f p)))
                                                     (Basis (Diff (g p)))
  basisValue :: Basis (AffineDiffProductSpace f g p)
-> AffineDiffProductSpace f g p
basisValue (Left Basis (Diff (f p))
bf) = forall (f :: * -> *) (g :: * -> *) p.
Diff (f p) -> Diff (g p) -> AffineDiffProductSpace f g p
AffineDiffProductSpace (forall v. HasBasis v => Basis v -> v
basisValue Basis (Diff (f p))
bf) forall v. AdditiveGroup v => v
zeroV
  basisValue (Right Basis (Diff (g p))
bg) = forall (f :: * -> *) (g :: * -> *) p.
Diff (f p) -> Diff (g p) -> AffineDiffProductSpace f g p
AffineDiffProductSpace forall v. AdditiveGroup v => v
zeroV (forall v. HasBasis v => Basis v -> v
basisValue Basis (Diff (g p))
bg)
  decompose :: AffineDiffProductSpace f g p
-> [(Basis (AffineDiffProductSpace f g p),
     Scalar (AffineDiffProductSpace f g p))]
decompose (AffineDiffProductSpace Diff (f p)
vf Diff (g p)
vg)
        = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. a -> Either a b
Left) (forall v. HasBasis v => v -> [(Basis v, Scalar v)]
decompose Diff (f p)
vf) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a b. b -> Either a b
Right) (forall v. HasBasis v => v -> [(Basis v, Scalar v)]
decompose Diff (g p)
vg)
  decompose' :: AffineDiffProductSpace f g p
-> Basis (AffineDiffProductSpace f g p)
-> Scalar (AffineDiffProductSpace f g p)
decompose' (AffineDiffProductSpace Diff (f p)
vf Diff (g p)
_) (Left Basis (Diff (f p))
bf) = forall v. HasBasis v => v -> Basis v -> Scalar v
decompose' Diff (f p)
vf Basis (Diff (f p))
bf
  decompose' (AffineDiffProductSpace Diff (f p)
_ Diff (g p)
vg) (Right Basis (Diff (g p))
bg) = forall v. HasBasis v => v -> Basis v -> Scalar v
decompose' Diff (g p)
vg Basis (Diff (g p))
bg


instance AffineSpace a => AffineSpace (Gnrx.Rec0 a s) where
  type Diff (Gnrx.Rec0 a s) = Diff a
  Gnrx.K1 a
v .+^ :: Rec0 a s -> Diff (Rec0 a s) -> Rec0 a s
.+^ Diff (Rec0 a s)
w = forall k i c (p :: k). c -> K1 i c p
Gnrx.K1 forall a b. (a -> b) -> a -> b
$ a
v forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff (Rec0 a s)
w
  Gnrx.K1 a
v .-. :: Rec0 a s -> Rec0 a s -> Diff (Rec0 a s)
.-. Gnrx.K1 a
w = a
v forall p. AffineSpace p => p -> p -> Diff p
.-. a
w
instance AffineSpace (f p) => AffineSpace (Gnrx.M1 i c f p) where
  type Diff (Gnrx.M1 i c f p) = Diff (f p)
  Gnrx.M1 f p
v .+^ :: M1 i c f p -> Diff (M1 i c f p) -> M1 i c f p
.+^ Diff (M1 i c f p)
w = forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
Gnrx.M1 forall a b. (a -> b) -> a -> b
$ f p
v forall p. AffineSpace p => p -> Diff p -> p
.+^ Diff (M1 i c f p)
w
  Gnrx.M1 f p
v .-. :: M1 i c f p -> M1 i c f p -> Diff (M1 i c f p)
.-. Gnrx.M1 f p
w = f p
v forall p. AffineSpace p => p -> p -> Diff p
.-. f p
w
instance (AffineSpace (f p), AffineSpace (g p)) => AffineSpace ((f :*: g) p) where
  type Diff ((f:*:g) p) = AffineDiffProductSpace f g p
  (f p
x:*:g p
y) .+^ :: (:*:) f g p -> Diff ((:*:) f g p) -> (:*:) f g p
.+^ AffineDiffProductSpace Diff (f p)
ξ Diff (g p)
υ = (f p
xforall p. AffineSpace p => p -> Diff p -> p
.+^Diff (f p)
ξ) forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
:*: (g p
yforall p. AffineSpace p => p -> Diff p -> p
.+^Diff (g p)
υ)
  (f p
x:*:g p
y) .-. :: (:*:) f g p -> (:*:) f g p -> Diff ((:*:) f g p)
.-. (f p
ξ:*:g p
υ) = forall (f :: * -> *) (g :: * -> *) p.
Diff (f p) -> Diff (g p) -> AffineDiffProductSpace f g p
AffineDiffProductSpace (f p
xforall p. AffineSpace p => p -> p -> Diff p
.-.f p
ξ) (g p
yforall p. AffineSpace p => p -> p -> Diff p
.-.g p
υ)