-- Copyright (c) 2010, David Amos. All rights reserved.

{-# LANGUAGE NoMonomorphismRestriction #-}

-- |A module defining tensor products of vector spaces
module Math.Algebras.TensorProduct where

import Math.Algebras.VectorSpace


data Tensor a b = T a b deriving (Eq, Ord, Show)
-- or T !a !b, forcing strictness, but not proven to be better


-- |Tensor product of two elements
te :: Num k => Vect k a -> Vect k b -> Vect k (Tensor a b)
te (V us) (V vs) = V [(T ei ej, xi*xj) | (ei,xi) <- us, (ej,xj) <- vs]
-- preserves order - that is, if the inputs are correctly ordered, so is the output

-- Implicit assumption - f and g are linear
-- |Tensor product of two (linear) functions
tf :: (Num k, Ord a', Ord b') => (Vect k a -> Vect k a') -> (Vect k b -> Vect k b')
   -> Vect k (Tensor a b) -> Vect k (Tensor a' b')
tf f g (V ts) = sum [te (f $ V [(a, 1)]) (g $ V [(b, x)]) | (T a b, x) <- ts]
    where sum = foldl add zero -- (V [])


-- tensor isomorphisms

-- in fact, this definition works for any Functor f, not just (Vect k)
assocL :: Vect k (Tensor u (Tensor v w)) -> Vect k (Tensor (Tensor u v) w)
assocL = fmap (\(T a (T b c)) -> T (T a b) c)

assocR :: Vect k (Tensor (Tensor u v) w) -> Vect k (Tensor u (Tensor v w))
assocR = fmap (\(T (T a b) c) -> T a (T b c))

inUnitL = fmap (\a -> T () a)

inUnitR = fmap (\a -> T a ())

outUnitL = fmap (\(T () a) -> a)

outUnitR = fmap (\(T a ()) -> a)

twist v = nf $ fmap (\(T a b) -> T b a) v
-- note the nf call, as f is not order-preserving