{-# LANGUAGE FlexibleInstances, FlexibleContexts, TypeOperators
           , TypeFamilies, TypeSynonymInstances 
           , UndecidableInstances  #-}
{-# OPTIONS_GHC -Wall #-}
----------------------------------------------------------------------
-- |
-- Module      :  Data.Cross
-- Copyright   :  (c) Conal Elliott 2008
-- License     :  BSD3
-- 
-- Maintainer  :  conal@conal.net
-- Stability   :  experimental
-- 
-- Cross products and normals
----------------------------------------------------------------------

module Data.Cross
  (
    HasNormal(..), normal
  , One, Two, Three
  , HasCross2(..), HasCross3(..)
  ) where

import Data.VectorSpace
import Data.MemoTrie
import Data.Basis

import Data.Derivative

-- | Thing with a normal vector (not necessarily normalized).
class HasNormal v where normalVec :: v -> v

-- | Normalized normal vector.  See also 'cross'.
normal :: (HasNormal v, InnerSpace v, Floating (Scalar v)) => v -> v
normal :: forall v.
(HasNormal v, InnerSpace v, Floating (Scalar v)) =>
v -> v
normal = forall v s. (InnerSpace v, s ~ Scalar v, Floating s) => v -> v
normalized forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. HasNormal v => v -> v
normalVec

-- | Singleton
type One   s = s

-- | Homogeneous pair
type Two   s = (s,s)

-- | Homogeneous triple
type Three s = (s,s,s)

-- | Cross product of various forms of 2D vectors
class HasCross2 v where cross2 :: v -> v

instance AdditiveGroup u => HasCross2 (u,u) where
  cross2 :: (u, u) -> (u, u)
cross2 (u
x,u
y) = (forall v. AdditiveGroup v => v -> v
negateV u
y,u
x)  -- or @(y,-x)@?

instance (HasTrie (Basis a), HasCross2 v) => HasCross2 (a:>v) where
  -- 2d cross-product is linear
  cross2 :: (a :> v) -> a :> v
cross2 = forall a b c. HasTrie (Basis a) => (b -> c) -> (a :> b) -> a :> c
fmapD forall v. HasCross2 v => v -> v
cross2

instance (HasBasis s, HasTrie (Basis s), Basis s ~ ()) =>
         HasNormal (One s :> Two s) where
  normalVec :: (s :> Two s) -> s :> Two s
normalVec s :> Two s
v = forall v. HasCross2 v => v -> v
cross2 (s :> Two s
v forall a b.
(HasTrie (Basis a), HasBasis a, AdditiveGroup b) =>
(a :> b) -> Basis a -> a :> b
`derivAtBasis` ())

-- When I use atBasis (from LinearMap) instead of the more liberally-typed
-- atB (below), I get a type error:
-- 
--     Couldn't match expected type `Basis a1' against inferred type `()'
--       Expected type: a1 :-* (s :> Two s)
--       Inferred type: s  :-* (s :> Two s)
--     In the first argument of `atB', namely `derivative v'
-- 
-- I think this type error is a GHC bug, but I'm not sure.

-- atB :: (AdditiveGroup b, HasTrie a) => Maybe (a :->: b) -> a -> b
-- -- atB :: (AdditiveGroup b, HasBasis a, HasTrie (Basis a)) =>
-- --        Maybe (Basis a :->: b) -> Basis a -> b
-- l `atB` b = maybe zeroV (`untrie` b) l


instance (VectorSpace s, HasBasis s, HasTrie (Basis s), Basis s ~ ())
    => HasNormal (Two (One s :> s)) where
  normalVec :: Two (s :> s) -> Two (s :> s)
normalVec = forall a b c.
HasTrie (Basis a) =>
(a :> (b, c)) -> (a :> b, a :> c)
unpairD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. HasNormal v => v -> v
normalVec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c.
(HasBasis a, HasTrie (Basis a), VectorSpace b, VectorSpace c) =>
(a :> b, a :> c) -> a :> (b, c)
pairD

-- I don't know why I can't eliminate the @HasTrie (Basis s)@ constraints
-- above, considering @Basis s ~ ()@ and @HasTrie ()@.

-- | Cross product of various forms of 3D vectors
class HasCross3 v where cross3 :: v -> v -> v

instance Num s => HasCross3 (s,s,s) where
  (s
ax,s
ay,s
az) cross3 :: (s, s, s) -> (s, s, s) -> (s, s, s)
`cross3` (s
bx,s
by,s
bz) = ( s
ay forall a. Num a => a -> a -> a
* s
bz forall a. Num a => a -> a -> a
- s
az forall a. Num a => a -> a -> a
* s
by
                                   , s
az forall a. Num a => a -> a -> a
* s
bx forall a. Num a => a -> a -> a
- s
ax forall a. Num a => a -> a -> a
* s
bz
                                   , s
ax forall a. Num a => a -> a -> a
* s
by forall a. Num a => a -> a -> a
- s
ay forall a. Num a => a -> a -> a
* s
bx )

-- TODO: Eliminate the 'Num' constraint by using 'VectorSpace' operations.

instance (HasBasis a, HasTrie (Basis a), VectorSpace v, HasCross3 v) => HasCross3 (a:>v) where
  -- 3D cross-product is bilinear (curried linear)
  cross3 :: (a :> v) -> (a :> v) -> a :> v
cross3 = forall a b c u.
(HasBasis a, HasTrie (Basis a), AdditiveGroup u) =>
(b -> c -> u) -> (a :> b) -> (a :> c) -> a :> u
distrib forall v. HasCross3 v => v -> v -> v
cross3

instance (Num s, HasTrie (Basis (s, s)), HasBasis s, Basis s ~ ()) =>
         HasNormal (Two s :> Three s) where
  normalVec :: ((s, s) :> Three s) -> (s, s) :> Three s
normalVec (s, s) :> Three s
v = Basis (s, s) -> (s, s) :> Three s
d (forall a b. a -> Either a b
Left ()) forall v. HasCross3 v => v -> v -> v
`cross3` Basis (s, s) -> (s, s) :> Three s
d (forall a b. b -> Either a b
Right ())
   where
     d :: Basis (s, s) -> (s, s) :> Three s
d = forall a b.
(HasTrie (Basis a), HasBasis a, AdditiveGroup b) =>
(a :> b) -> Basis a -> a :> b
derivAtBasis (s, s) :> Three s
v

instance ( VectorSpace s, HasBasis s, HasTrie (Basis s)
         , HasNormal (Two s :> Three s) )
         => HasNormal (Three (Two s :> s)) where
  normalVec :: Three (Two s :> s) -> Three (Two s :> s)
normalVec = forall a b c d.
HasTrie (Basis a) =>
(a :> (b, c, d)) -> (a :> b, a :> c, a :> d)
untripleD forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. HasNormal v => v -> v
normalVec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c d.
(HasBasis a, HasTrie (Basis a), VectorSpace b, VectorSpace c,
 VectorSpace d) =>
(a :> b, a :> c, a :> d) -> a :> (b, c, d)
tripleD