-- |
-- Module      : Math.LinearMap.Category.TensorQuot
-- Copyright   : (c) Justus Sagemüller 2016
-- License     : GPL v3
-- 
-- Maintainer  : (@) jsag $ hvl.no
-- Stability   : experimental
-- Portability : portable
-- 


{-# LANGUAGE CPP                   #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE UnicodeSyntax         #-}
{-# LANGUAGE TupleSections         #-}
{-# LANGUAGE ConstraintKinds       #-}

module Math.LinearMap.Category.TensorQuot where

import Math.LinearMap.Category.Class
import Math.LinearMap.Category.Instances
import Math.LinearMap.Asserted

import Data.VectorSpace
import Data.VectorSpace.Free

infixl 7 ·

class (TensorSpace v, VectorSpace w) => TensorQuot v w where
  type v ⨸ w :: *
  -- | Generalised multiplication operation. This subsumes '<.>^' and '*^'.
  --   For scalars therefore also '*', and for 'InnerSpace', '<.>'.
  (·) :: v ⨸ w -> v -> w

instance TensorQuot Double Double where
  type Double ⨸ Double = Double
  · :: (Double ⨸ Double) -> Double -> Double
(·) = forall a. Num a => a -> a -> a
(*)

instance ( TensorQuot x v, TensorQuot y w
         , Scalar x ~ Scalar y, Scalar v ~ Scalar w
         , (x⨸v) ~ (y⨸w) )
      => TensorQuot (x,y) (v,w) where
  type (x,y) ⨸ (v,w) = x⨸v
  (x, y) ⨸ (v, w)
μ· :: ((x, y) ⨸ (v, w)) -> (x, y) -> (v, w)
·(x
x,y
y) = ((x, y) ⨸ (v, w)
μforall v w. TensorQuot v w => (v ⨸ w) -> v -> w
·x
x, (x, y) ⨸ (v, w)
μforall v w. TensorQuot v w => (v ⨸ w) -> v -> w
·y
y)
instance ( TensorQuot x Double, TensorQuot y Double
         , Scalar x ~ Double, Scalar y ~ Double )
      => TensorQuot (x,y) Double where
  type (x,y) ⨸ Double = (x ⨸ Double, y ⨸ Double)
  (x ⨸ Double
v,y ⨸ Double
w)· :: ((x, y) ⨸ Double) -> (x, y) -> Double
·(x
x,y
y) = x ⨸ Double
vforall v w. TensorQuot v w => (v ⨸ w) -> v -> w
·x
x forall a. Num a => a -> a -> a
+ y ⨸ Double
wforall v w. TensorQuot v w => (v ⨸ w) -> v -> w
·y
y

#define FreeTensorQuot(V)                                \
instance (Num' s, Eq s) => TensorQuot (V s) (V s) where { \
  type V s ⨸ V s = s;                                      \
  (·) = (*^) };                                             \
instance TensorQuot (V Double) Double where {                \
  type V Double ⨸ Double = V Double;                          \
  (·) = (<.>) }

FreeTensorQuot(V1)
FreeTensorQuot(V2)
FreeTensorQuot(V3)
FreeTensorQuot(V4)

instance ∀ s x y v w .
    ( TensorSpace v, TensorSpace w, v ~ x, LinearSpace y
    , TensorQuot x v, TensorQuot y w, (x⨸v) ~ s, (y⨸w) ~ s
    , Scalar x ~ s, Scalar y ~ s, Scalar v ~ s, Scalar w ~ s )
      => TensorQuot (Tensor s x y) (Tensor s v w) where
  type Tensor s x y ⨸ Tensor s v w = s
  Tensor s x y ⨸ Tensor s v w
μ· :: (Tensor s x y ⨸ Tensor s v w) -> Tensor s x y -> Tensor s v w
·Tensor s x y
t = (forall v w x.
(TensorSpace v, TensorSpace w, TensorSpace x, Scalar w ~ Scalar v,
 Scalar x ~ Scalar v) =>
Bilinear (w -+> x) (v ⊗ w) (v ⊗ x)
fmapTensorforall s v w. LinearFunction s v w -> v -> w
-+$>forall (f :: * -> * -> *) s u v.
(EnhancedCat f (LinearFunction s), LinearSpace u, TensorSpace v,
 Scalar u ~ s, Scalar v ~ s, Object f u, Object f v) =>
(u -> v) -> f u v
lfun(Tensor s x y ⨸ Tensor s v w
μforall v w. TensorQuot v w => (v ⨸ w) -> v -> w
·))forall s v w. LinearFunction s v w -> v -> w
-+$>Tensor s x y
t
instance ( LinearSpace x, LinearSpace y
         , s ~ Double, Scalar x ~ s, Scalar y ~ s )
      => TensorQuot (Tensor s x y) Double where
  type (Tensor s x y) ⨸ Double = DualVector (Tensor s x y)
  Tensor s x y ⨸ Double
f· :: (Tensor s x y ⨸ Double) -> Tensor s x y -> Double
·Tensor s x y
t = (forall v u.
(LinearSpace v, LinearSpace u, Scalar u ~ Scalar v) =>
Bilinear (DualVector (v ⊗ u)) (v ⊗ u) (Scalar v)
applyTensorFunctionalforall s v w. LinearFunction s v w -> v -> w
-+$>Tensor s x y ⨸ Double
f)forall s v w. LinearFunction s v w -> v -> w
-+$>Tensor s x y
t