AlgebraRelations package

A subpackage for QuantumGroups v2.
Version 2.0, June 11, 2005, Scott Morrison

Introduction

This package produces the relations for a quantum group, and checks that they hold in a given representation.

Implementation

Start of package

Specify package dependencies:

BeginPackage["QuantumGroups`AlgebraRelations`",{"QuantumGroups`","QuantumGroups`RootSystems`","QuantumGroups`Utilities`Debugging`","QuantumGroups`Utilities`MatrixWrapper`","QuantumGroups`MatrixPresentations`","QuantumGroups`Algebra`","QuantumGroups`Representations`"}];

Usage messages

Relations::usage="";

CheckRelations::usage="";

Internals

Begin["`Private`"];

q=Global`q

qBinomial[n_,k_][q_]:=((qFactorial[n][q])/(qFactorial[n-k][q]qFactorial[k][q]))

BasicRelations[Γ_]:=With[{cm=CartanMatrix[Γ],cf=CartanFactors[Γ],n=Rank[Γ]},
DeleteCases[Flatten[Join[
Table[(Subscript[K, i])**(Subscript[K, j])==(Subscript[K, j])**(Subscript[K, i]),{i,1,n},{j,i+1,n}],
Table[(Subscript[K, i])**((Subscript[K, i])^(-1))==\[ScriptOne],{i,1,n}],
Table[((Subscript[K, i])^(-1))**(Subscript[K, i])==\[ScriptOne],{i,1,n}],
Table[(Subscript[K, i])**SuperPlus[(Subscript[X, j])]**((Subscript[K, i])^(-1))==(q^(cf[[i]]cm[[i,j]]))SuperPlus[(Subscript[X, j])],{i,1,n},{j,1,n}],
Table[(Subscript[K, i])**SuperMinus[(Subscript[X, j])]**((Subscript[K, i])^(-1))==(q^(-cf[[i]]cm[[i,j]]))SuperMinus[(Subscript[X, j])],{i,1,n},{j,1,n}],
Table[SuperPlus[(Subscript[X, i])]**SuperMinus[(Subscript[X, j])]-SuperMinus[(Subscript[X, j])]**SuperPlus[(Subscript[X, i])]==DiscreteDelta[i-j](((Subscript[K, i])-((Subscript[K, i])^(-1)))/((q^(cf[[i]]))-(q^(-cf[[i]])))),{i,1,n},{j,1,n}]

]]/.{0->\[ScriptZero]},True]
]

SerreRelations[Γ_]:=With[{cm=CartanMatrix[Γ],cf=CartanFactors[Γ],n=Rank[Γ]},
DeleteCases[Flatten[Join[
Table[Sum[(((-1))^r)qBinomial[1-cm[[i,j]],r][(q^(cf[[i]]))]NonCommutativePower[SuperPlus[(Subscript[X, i])],1-cm[[i,j]]-r]**SuperPlus[(Subscript[X, j])]**NonCommutativePower[SuperPlus[(Subscript[X, i])],r],{r,0,1-cm[[i,j]]}]==\[ScriptZero],{i,1,n},{j,1,n}],
Table[Sum[(((-1))^r)qBinomial[1-cm[[i,j]],r][(q^(cf[[i]]))]NonCommutativePower[SuperMinus[(Subscript[X, i])],1-cm[[i,j]]-r]**SuperMinus[(Subscript[X, j])]**NonCommutativePower[SuperMinus[(Subscript[X, i])],r],{r,0,1-cm[[i,j]]}]==\[ScriptZero],{i,1,n},{j,1,n}]
]]/.{0->\[ScriptZero]},True]
]

(*SerreRelations[Γ_]:=With[{cm=CartanMatrix[Γ],cf=CartanFactors[Γ],n=Rank[Γ]},
DeleteCases[Flatten[Join[
Table[(∑_(r=0)^(1-cm[[i,j]]))(((-1))^r)qBinomial[1-cm[[i,j]],r][(q^(cf[[i]]))]NonCommutativePower[SuperPlus[(Subscript[X, i])],1-cm[[i,j]]-r]**SuperPlus[(Subscript[X, j])]**NonCommutativePower[SuperPlus[(Subscript[X, i])],r]==\[ScriptZero],{i,1,n},{j,1,n}],
Table[(∑_(r=0)^(1-cm[[i,j]]))(((-1))^r)qBinomial[1-cm[[i,j]],r][(q^(cf[[i]]))]NonCommutativePower[SuperMinus[(Subscript[X, i])],1-cm[[i,j]]-r]**SuperMinus[(Subscript[X, j])]**NonCommutativePower[SuperMinus[(Subscript[X, i])],r]==\[ScriptZero],{i,1,n},{j,1,n}]
]]/.{0->\[ScriptZero]},True]
]*)

Relations[Γ_]:=BasicRelations[Γ]~Join~SerreRelations[Γ]

CheckRelationsInternal[Γ_][V_,β_,λ_]:=(Simplify[Relations[Γ]/.{a_==\[ScriptZero]:>ZeroMatrixQ[Simplify[MatrixPresentation[Γ][a][V,β,λ]]],a_==b_:>ZeroMatrixQ[Simplify[MatrixPresentation[Γ][a-b][V,β,λ]]]}])

CheckBasicRelations[Γ_][V_,β_,λ_]:=(Simplify[BasicRelations[Γ]/.{a_==\[ScriptZero]:>ZeroMatrixQ[Simplify[MatrixPresentation[Γ][a][V,β,λ]]],a_==b_:>ZeroMatrixQ[Simplify[MatrixPresentation[Γ][a-b][V,β,λ]]]}])

CheckRelations[Γ_][V_,β_,λ_]:=And@@(Simplify[Relations[Γ]/.{a_==\[ScriptZero]:>ZeroMatrixQ[Simplify[MatrixPresentation[Γ][a][V,β,λ]]],a_==b_:>ZeroMatrixQ[Simplify[MatrixPresentation[Γ][a-b][V,β,λ]]]}])

CheckRelations[Γ_][V_,β_]:=And@@(CheckRelations[Γ][V,β,#]&/@Weights[Γ,V])

End[];

End of package

EndPackage[];