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

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

-- |A module defining the tensor algebra, symmetric algebra, and exterior (or alternating) algebra
module Math.Algebras.TensorAlgebra where

import qualified Data.List as L

import Math.Algebras.VectorSpace
import Math.Algebras.TensorProduct
import Math.Algebras.Structures

import Math.Algebra.Field.Base


data TensorAlgebra a = TA Int [a] deriving (Eq,Ord,Show)

instance Mon (TensorAlgebra a) where
    munit = TA 0 []
    mmult (TA i xs) (TA j ys) = TA (i+j) (xs++ys)

instance (Num k, Ord a) => Algebra k (TensorAlgebra a) where
    unit 0 = zero -- V []
    unit x = V [(munit,x)]
    mult = nf . fmap (\(T a b) -> a `mmult` b)


data SymmetricAlgebra a = Sym Int [a] deriving (Eq,Ord,Show)

instance Ord a => Mon (SymmetricAlgebra a) where
    munit = Sym 0 []
    mmult (Sym i xs) (Sym j ys) = Sym (i+j) $ L.sort (xs++ys)

instance (Num k, Ord a) => Algebra k (SymmetricAlgebra a) where
    unit 0 = zero -- V []
    unit x = V [(munit,x)]
    mult = nf . fmap (\(T a b) -> a `mmult` b)


data ExteriorAlgebra a = Ext Int [a] deriving (Eq,Ord,Show)

instance (Num k, Ord a) => Algebra k (ExteriorAlgebra a) where
    unit 0 = zero -- V []
    unit x = V [(Ext 0 [],x)]
    mult xy = nf $ xy >>= (\(T (Ext i xs) (Ext j ys)) -> signedMerge 1 (0,[]) (i,xs) (j,ys))
        where signedMerge s (k,zs) (i,x:xs) (j,y:ys) =
                  case compare x y of
                  EQ -> zero
                  LT -> signedMerge s (k+1,x:zs) (i-1,xs) (j,y:ys)
                  GT -> let s' = if even i then s else -s -- we had to commute y past x:xs, with i sign changes
                        in signedMerge s' (k+1,y:zs) (i,x:xs) (j-1,ys)
              signedMerge s (k,zs) (i,xs) (0,[]) = s *> (return $ Ext (k+i) $ reverse zs ++ xs)
              signedMerge s (k,zs) (0,[]) (j,ys) = s *> (return $ Ext (k+j) $ reverse zs ++ ys)