-- 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 (Basis -> Basis -> Bool
(Basis -> Basis -> Bool) -> (Basis -> Basis -> Bool) -> Eq Basis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Basis -> Basis -> Bool
$c/= :: Basis -> Basis -> Bool
== :: Basis -> Basis -> Bool
$c== :: Basis -> Basis -> Bool
Eq,Eq Basis
Eq Basis =>
(Basis -> Basis -> Ordering)
-> (Basis -> Basis -> Bool)
-> (Basis -> Basis -> Bool)
-> (Basis -> Basis -> Bool)
-> (Basis -> Basis -> Bool)
-> (Basis -> Basis -> Basis)
-> (Basis -> Basis -> Basis)
-> Ord Basis
Basis -> Basis -> Bool
Basis -> Basis -> Ordering
Basis -> Basis -> Basis
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Basis -> Basis -> Basis
$cmin :: Basis -> Basis -> Basis
max :: Basis -> Basis -> Basis
$cmax :: Basis -> Basis -> Basis
>= :: Basis -> Basis -> Bool
$c>= :: Basis -> Basis -> Bool
> :: Basis -> Basis -> Bool
$c> :: Basis -> Basis -> Bool
<= :: Basis -> Basis -> Bool
$c<= :: Basis -> Basis -> Bool
< :: Basis -> Basis -> Bool
$c< :: Basis -> Basis -> Bool
compare :: Basis -> Basis -> Ordering
$ccompare :: Basis -> Basis -> Ordering
$cp1Ord :: Eq Basis
Ord)

instance Show Basis where
    show :: Basis -> String
show (E i :: Int
i) = 'e'Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i

e_ :: Int -> NPoly Q Basis
e_ i :: Int
i = [(Monomial Basis, Q)] -> NPoly Q Basis
forall r v. [(Monomial v, r)] -> NPoly r v
NP [([Basis] -> Monomial Basis
forall v. [v] -> Monomial v
M [Int -> Basis
E Int
i], 1)] :: NPoly Q Basis

e1 :: NPoly Q Basis
e1 = Int -> NPoly Q Basis
e_ 1
e2 :: NPoly Q Basis
e2 = Int -> NPoly Q Basis
e_ 2
e3 :: NPoly Q Basis
e3 = Int -> NPoly Q Basis
e_ 3
e4 :: NPoly Q Basis
e4 = Int -> NPoly Q Basis
e_ 4

-- given an elt of the tensor algebra, return the dimension of the vector space it's defined over

dim :: NPoly r Basis -> Int
dim (NP ts :: [(Monomial Basis, r)]
ts) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ 0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
i | (M bs :: [Basis]
bs,c :: r
c) <- [(Monomial Basis, r)]
ts, E i :: Int
i <- [Basis]
bs]

-- Monomial basis for tensor algebra over k^n - infinite

tensorBasis :: Int -> [NPoly Q Basis]
tensorBasis n :: Int
n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
forall r v.
(Eq r, Fractional r, Ord v, Show v) =>
[NPoly r v] -> [NPoly r v] -> [NPoly r v]
mbasisQA [Int -> NPoly Q Basis
e_ Int
i | Int
i <- [1..Int
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 :: Int -> [NPoly Q Basis]
extRelations n :: Int
n = [Int -> NPoly Q Basis
e_ Int
i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
i | Int
i <- [1..Int
n] ] [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
forall a. [a] -> [a] -> [a]
++
                 [Int -> NPoly Q Basis
e_ Int
i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
+ Int -> NPoly Q Basis
e_ Int
j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
i | Int
i <- [1..Int
n], Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1..Int
n] ]

extnf :: NPoly Q Basis -> NPoly Q Basis
extnf t :: NPoly Q Basis
t = NPoly Q Basis
t NPoly Q Basis -> [NPoly Q Basis] -> NPoly Q Basis
forall r v.
(Fractional r, Ord v, Show v, Eq r) =>
NPoly r v -> [NPoly r v] -> NPoly r v
%% (Int -> [NPoly Q Basis]
extRelations (Int -> [NPoly Q Basis]) -> Int -> [NPoly Q Basis]
forall a b. (a -> b) -> a -> b
$ NPoly Q Basis -> Int
forall r. NPoly r Basis -> Int
dim NPoly Q Basis
t)

-- Monomial basis for exterior algebra over k^n - finite

exteriorBasis :: Int -> [NPoly Q Basis]
exteriorBasis n :: Int
n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
forall r v.
(Eq r, Fractional r, Ord v, Show v) =>
[NPoly r v] -> [NPoly r v] -> [NPoly r v]
mbasisQA [Int -> NPoly Q Basis
e_ Int
i | Int
i <- [1..Int
n]] ([NPoly Q Basis] -> [NPoly Q Basis])
-> [NPoly Q Basis] -> [NPoly Q Basis]
forall a b. (a -> b) -> a -> b
$ Int -> [NPoly Q Basis]
extRelations Int
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 :: Int -> [NPoly Q Basis]
symRelations n :: Int
n = [Int -> NPoly Q Basis
e_ Int
i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
- Int -> NPoly Q Basis
e_ Int
j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
i | Int
i <- [1..Int
n], Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1..Int
n] ]

symnf :: NPoly Q Basis -> NPoly Q Basis
symnf t :: NPoly Q Basis
t = NPoly Q Basis
t NPoly Q Basis -> [NPoly Q Basis] -> NPoly Q Basis
forall r v.
(Fractional r, Ord v, Show v, Eq r) =>
NPoly r v -> [NPoly r v] -> NPoly r v
%% (Int -> [NPoly Q Basis]
symRelations (Int -> [NPoly Q Basis]) -> Int -> [NPoly Q Basis]
forall a b. (a -> b) -> a -> b
$ NPoly Q Basis -> Int
forall r. NPoly r Basis -> Int
dim NPoly Q Basis
t)

-- Monomial basis for symmetric algebra over k^n - infinite

symmetricBasis :: Int -> [NPoly Q Basis]
symmetricBasis n :: Int
n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
forall r v.
(Eq r, Fractional r, Ord v, Show v) =>
[NPoly r v] -> [NPoly r v] -> [NPoly r v]
mbasisQA [Int -> NPoly Q Basis
e_ Int
i | Int
i <- [1..Int
n]] ([NPoly Q Basis] -> [NPoly Q Basis])
-> [NPoly Q Basis] -> [NPoly Q Basis]
forall a b. (a -> b) -> a -> b
$ Int -> [NPoly Q Basis]
symRelations Int
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 :: Int -> [NPoly Q Basis]
weylRelations n :: Int
n = [Int -> NPoly Q Basis
e_ Int
j NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
- Int -> NPoly Q Basis
e_ Int
i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
j | Int
i <- [1..2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n], Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1..2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n], Int
j Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n ] [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
forall a. [a] -> [a] -> [a]
++
                  [Int -> NPoly Q Basis
e_ (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ Int
i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
- Int -> NPoly Q Basis
e_ Int
i NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
* Int -> NPoly Q Basis
e_ (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
n) NPoly Q Basis -> NPoly Q Basis -> NPoly Q Basis
forall a. Num a => a -> a -> a
- 1 | Int
i <- [1..Int
n] ]

weylnf :: Int -> NPoly Q Basis -> NPoly Q Basis
weylnf n :: Int
n t :: NPoly Q Basis
t = NPoly Q Basis
t NPoly Q Basis -> [NPoly Q Basis] -> NPoly Q Basis
forall r v.
(Fractional r, Ord v, Show v, Eq r) =>
NPoly r v -> [NPoly r v] -> NPoly r v
%% (Int -> [NPoly Q Basis]
weylRelations Int
n)

weylBasis :: Int -> [NPoly Q Basis]
weylBasis n :: Int
n = [NPoly Q Basis] -> [NPoly Q Basis] -> [NPoly Q Basis]
forall r v.
(Eq r, Fractional r, Ord v, Show v) =>
[NPoly r v] -> [NPoly r v] -> [NPoly r v]
mbasisQA [Int -> NPoly Q Basis
e_ Int
i | Int
i <- [1..2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
n]] ([NPoly Q Basis] -> [NPoly Q Basis])
-> [NPoly Q Basis] -> [NPoly Q Basis]
forall a b. (a -> b) -> a -> b
$ Int -> [NPoly Q Basis]
weylRelations Int
n


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


data WeylGens = X Int | D Int deriving (WeylGens -> WeylGens -> Bool
(WeylGens -> WeylGens -> Bool)
-> (WeylGens -> WeylGens -> Bool) -> Eq WeylGens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WeylGens -> WeylGens -> Bool
$c/= :: WeylGens -> WeylGens -> Bool
== :: WeylGens -> WeylGens -> Bool
$c== :: WeylGens -> WeylGens -> Bool
Eq,Eq WeylGens
Eq WeylGens =>
(WeylGens -> WeylGens -> Ordering)
-> (WeylGens -> WeylGens -> Bool)
-> (WeylGens -> WeylGens -> Bool)
-> (WeylGens -> WeylGens -> Bool)
-> (WeylGens -> WeylGens -> Bool)
-> (WeylGens -> WeylGens -> WeylGens)
-> (WeylGens -> WeylGens -> WeylGens)
-> Ord WeylGens
WeylGens -> WeylGens -> Bool
WeylGens -> WeylGens -> Ordering
WeylGens -> WeylGens -> WeylGens
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WeylGens -> WeylGens -> WeylGens
$cmin :: WeylGens -> WeylGens -> WeylGens
max :: WeylGens -> WeylGens -> WeylGens
$cmax :: WeylGens -> WeylGens -> WeylGens
>= :: WeylGens -> WeylGens -> Bool
$c>= :: WeylGens -> WeylGens -> Bool
> :: WeylGens -> WeylGens -> Bool
$c> :: WeylGens -> WeylGens -> Bool
<= :: WeylGens -> WeylGens -> Bool
$c<= :: WeylGens -> WeylGens -> Bool
< :: WeylGens -> WeylGens -> Bool
$c< :: WeylGens -> WeylGens -> Bool
compare :: WeylGens -> WeylGens -> Ordering
$ccompare :: WeylGens -> WeylGens -> Ordering
$cp1Ord :: Eq WeylGens
Ord)

instance Show WeylGens where
    show :: WeylGens -> String
show (D i :: Int
i) = 'd'Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i
    show (X i :: Int
i) = 'x'Char -> ShowS
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i

d_ :: Int -> NPoly Q WeylGens
d_ i :: Int
i = [(Monomial WeylGens, Q)] -> NPoly Q WeylGens
forall r v. [(Monomial v, r)] -> NPoly r v
NP [([WeylGens] -> Monomial WeylGens
forall v. [v] -> Monomial v
M [Int -> WeylGens
D Int
i], 1)] :: NPoly Q WeylGens
x_ :: Int -> NPoly Q WeylGens
x_ i :: Int
i = [(Monomial WeylGens, Q)] -> NPoly Q WeylGens
forall r v. [(Monomial v, r)] -> NPoly r v
NP [([WeylGens] -> Monomial WeylGens
forall v. [v] -> Monomial v
M [Int -> WeylGens
X Int
i], 1)] :: NPoly Q WeylGens

d1 :: NPoly Q WeylGens
d1 = Int -> NPoly Q WeylGens
d_ 1
d2 :: NPoly Q WeylGens
d2 = Int -> NPoly Q WeylGens
d_ 2
d3 :: NPoly Q WeylGens
d3 = Int -> NPoly Q WeylGens
d_ 3

x1 :: NPoly Q WeylGens
x1 = Int -> NPoly Q WeylGens
x_ 1
x2 :: NPoly Q WeylGens
x2 = Int -> NPoly Q WeylGens
x_ 2
x3 :: NPoly Q WeylGens
x3 = Int -> NPoly Q WeylGens
x_ 3

comm :: a -> a -> a
comm p :: a
p q :: a
q = a
pa -> a -> a
forall a. Num a => a -> a -> a
*a
q a -> a -> a
forall a. Num a => a -> a -> a
- a
qa -> a -> a
forall a. Num a => a -> a -> a
*a
p

delta :: a -> a -> p
delta i :: a
i j :: a
j = if a
i a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
j then 1 else 0

weylRelations' :: Int -> [NPoly Q WeylGens]
weylRelations' n :: Int
n = [NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
forall a. Num a => a -> a -> a
comm (Int -> NPoly Q WeylGens
x_ Int
i) (Int -> NPoly Q WeylGens
x_ Int
j) | Int
i <- [1..Int
n], Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1..Int
n] ] [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
forall a. [a] -> [a] -> [a]
++
                   [NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
forall a. Num a => a -> a -> a
comm (Int -> NPoly Q WeylGens
d_ Int
i) (Int -> NPoly Q WeylGens
d_ Int
j) | Int
i <- [1..Int
n], Int
j <- [Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1..Int
n] ] [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
forall a. [a] -> [a] -> [a]
++
                   [NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
forall a. Num a => a -> a -> a
comm (Int -> NPoly Q WeylGens
d_ Int
i) (Int -> NPoly Q WeylGens
x_ Int
j) NPoly Q WeylGens -> NPoly Q WeylGens -> NPoly Q WeylGens
forall a. Num a => a -> a -> a
- Int -> Int -> NPoly Q WeylGens
forall a p. (Eq a, Num p) => a -> a -> p
delta Int
i Int
j | Int
i <- [1..Int
n], Int
j <- [1..Int
n] ]

weylnf' :: NPoly Q WeylGens -> NPoly Q WeylGens
weylnf' f :: NPoly Q WeylGens
f@(NP ts :: [(Monomial WeylGens, Q)]
ts) = NPoly Q WeylGens
f NPoly Q WeylGens -> [NPoly Q WeylGens] -> NPoly Q WeylGens
forall r v.
(Fractional r, Ord v, Show v, Eq r) =>
NPoly r v -> [NPoly r v] -> NPoly r v
%% Int -> [NPoly Q WeylGens]
weylRelations' Int
n where
    n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ 0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int
i | (M bs :: [WeylGens]
bs,c :: Q
c) <- [(Monomial WeylGens, Q)]
ts, X i <- [WeylGens]
bs] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
i | (M bs :: [WeylGens]
bs,c :: Q
c) <- [(Monomial WeylGens, Q)]
ts, D i <- [WeylGens]
bs]

weylBasis' :: Int -> [NPoly Q WeylGens]
weylBasis' n :: Int
n = [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
forall r v.
(Eq r, Fractional r, Ord v, Show v) =>
[NPoly r v] -> [NPoly r v] -> [NPoly r v]
mbasisQA ((Int -> NPoly Q WeylGens) -> [Int] -> [NPoly Q WeylGens]
forall a b. (a -> b) -> [a] -> [b]
map Int -> NPoly Q WeylGens
x_ [1..Int
n] [NPoly Q WeylGens] -> [NPoly Q WeylGens] -> [NPoly Q WeylGens]
forall a. [a] -> [a] -> [a]
++ (Int -> NPoly Q WeylGens) -> [Int] -> [NPoly Q WeylGens]
forall a b. (a -> b) -> [a] -> [b]
map Int -> NPoly Q WeylGens
d_ [1..Int
n]) (Int -> [NPoly Q WeylGens]
weylRelations' Int
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)
-}