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

-- |A module defining the tensor, symmetric, and exterior algebras.
-- This module has been partially superceded by Math.Algebras.TensorAlgebra, which should be used in preference.
-- This module is likely to be removed at some point.
module Math.Algebra.NonCommutative.TensorAlgebra where

import Math.Algebra.Field.Base
import Math.Algebra.NonCommutative.NCPoly hiding (X)
import Math.Algebra.NonCommutative.GSBasis


-- TENSOR ALGEBRA
-- Tensor product satisfies the universal property that any multilinear map from the cartesian product can be factored through the tensor product

-- The tensor algebra is the free algebra on the basis elts of the vector space

data Basis = E Int deriving (Eq,Ord)

instance Show Basis where
    show (E i) = 'e': show i

e_ i = NP [(M [E i], 1)] :: NPoly Q Basis

e1 = e_ 1
e2 = e_ 2
e3 = e_ 3
e4 = e_ 4

-- given an elt of the tensor algebra, return the dimension of the vector space it's defined over
dim (NP ts) = maximum $ 0 : [i | (M bs,c) <- ts, E i <- bs]

-- Monomial basis for tensor algebra over k^n - infinite
tensorBasis n = mbasisQA [e_ i | i <- [1..n]] []


-- EXTERIOR ALGEBRA
-- Exterior product satisfies the universal property that any alternating multilinear map from the cartesian product can be factored through the exterior product

-- Exterior algebra over k^n is tensor algebra over k^n quotiented by these relations
extRelations n = [e_ i * e_ i | i <- [1..n] ] ++
                 [e_ i * e_ j + e_ j * e_ i | i <- [1..n], j <- [i+1..n] ]

extnf t = t %% (extRelations $ dim t)

-- Monomial basis for exterior algebra over k^n - finite
exteriorBasis n = mbasisQA [e_ i | i <- [1..n]] $ extRelations n


-- SYMMETRIC ALGEBRA
-- Symmetric product satisfies the universal property that any symmetric multilinear map from the cartesian product can be factored through the symmetric product

-- Symmetric algebra over k^n is tensor algebra over k^n quotiented by these relations
symRelations n = [e_ i * e_ j - e_ j * e_ i | i <- [1..n], j <- [i+1..n] ]

symnf t = t %% (symRelations $ dim t)

-- Monomial basis for symmetric algebra over k^n - infinite
symmetricBasis n = mbasisQA [e_ i | i <- [1..n]] $ symRelations n


-- WEYL ALGEBRAS
-- http://en.wikipedia.org/wiki/Weyl_algebra
-- Coutinho, A Primer of Algebraic D-modules, ch1

-- Given a symplectic form w, represented by
-- [0  I]
-- [-I 0]
-- on R^2n
-- The Weyl algebra is the tensor algebra quotiented by < u*v-v*u-w(u,v) >
-- It has a natural interpretation as an operator algebra in which
-- e_1 .. e_i .. e_n correspond to x_i (the "multiply by x_i" operator),
-- e_n+1 .. e_n+i .. e_2*n correspond to d_x_i (the "differentiate wrt x_i" operator)

-- Weyl algebra W(V) is a "quantization" of the Symmetric algebra Sym(V)

weylRelations n = [e_ j * e_ i - e_ i * e_ j | i <- [1..2*n], j <- [i+1..2*n], j /= i+n ] ++
                  [e_ (i+n) * e_ i - e_ i * e_ (i+n) - 1 | i <- [1..n] ]

weylnf n t = t %% (weylRelations n)

weylBasis n = mbasisQA [e_ i | i <- [1..2*n]] $ weylRelations n


-- Explicit construction of Weyl algebra in terms of d_x_i and x_i operators

data WeylGens = X Int | D Int deriving (Eq,Ord)

instance Show WeylGens where
    show (D i) = 'd': show i
    show (X i) = 'x': show i

d_ i = NP [(M [D i], 1)] :: NPoly Q WeylGens
x_ i = NP [(M [X i], 1)] :: NPoly Q WeylGens

d1 = d_ 1
d2 = d_ 2
d3 = d_ 3

x1 = x_ 1
x2 = x_ 2
x3 = x_ 3

comm p q = p*q - q*p

delta i j = if i == j then 1 else 0

weylRelations' n = [comm (x_ i) (x_ j) | i <- [1..n], j <- [i+1..n] ] ++
                   [comm (d_ i) (d_ j) | i <- [1..n], j <- [i+1..n] ] ++
                   [comm (d_ i) (x_ j) - delta i j | i <- [1..n], j <- [1..n] ]

weylnf' f@(NP ts) = f %% weylRelations' n where
    n = maximum $ 0 : [i | (M bs,c) <- ts, X i <- bs] ++ [i | (M bs,c) <- ts, D i <- bs]

weylBasis' n = mbasisQA (map x_ [1..n] ++ map d_ [1..n]) (weylRelations' n)

{-
-- HEISENBERG ALGEBRA

data Heisenberg = D | U deriving (Eq,Ord)

instance Show Heisenberg where
    show D = "d"
    show U = "u"

d = NP [(M [D], 1)] :: NPoly Q Heisenberg
u = NP [(M [U], 1)] :: NPoly Q Heisenberg


heisenberg = [u*d-d*u-1]


-- Monomial basis for Heisenberg algebra - infinite
hBasis = mbasisQA [d,u] (gb heisenberg)
-}