QuantumGroups`Algebra` package

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

Introduction

Implementation

BeginPackage["QuantumGroups`Algebra`",{"QuantumGroups`","QuantumGroups`RootSystems`","QuantumGroups`WeylGroups`"}]

X;K;\[ScriptOne];\[ScriptZero];

SuperPlus;SuperMinus;

PositiveGenerators;NegativeGenerators;CartanGenerators;Generators;NonCommutativePower;Δ;Δop;OperatorWeight;OperatorLength;

Begin["`Private`"];

PositiveGenerators[Γ_]:=Table[SuperPlus[(Subscript[X, i])],{i,1,Rank[Γ]}];

NegativeGenerators[Γ_]:=Table[SuperMinus[(Subscript[X, i])],{i,1,Rank[Γ]}];

CartanGenerators[Γ_]:=Table[(Subscript[K, i]),{i,1,Rank[Γ]}];

Generators[Γ_]:=CartanGenerators[Γ]~Join~PositiveGenerators[Γ]~Join~NegativeGenerators[Γ]

Composition

Unprotect[NonCommutativeMultiply];

0**b_:=0

a_**0:=0

a_**b_Plus:=a**#&/@b

a_Plus**b_:=#**b&/@a

(α_?qNumberQ a_)**b_:=α(a**b)
a_**(α_?qNumberQ b_):=α(a**b)

\[ScriptOne]**Z_:=Z
Z_**\[ScriptOne]:=Z

(a_⊗b_)**(c_⊗d_):=(a**c)⊗(b**d)

NonCommutativePower[x_,n_?(#≥2&)]:=NonCommutativeMultiply@@Table[x,{n}]

NonCommutativePower[x_,1]:=x

NonCommutativePower[x_,0]:=\[ScriptOne]

NonCommutativePower[x_,n_?(#<0&)]:=NonCommutativePower[(x^(-1)),-n]

Protect[NonCommutativeMultiply];

Comultiplication

Δ[\[ScriptOne]]=\[ScriptOne]⊗\[ScriptOne];
Δ[(Subscript[K, i_])]:=(Subscript[K, i])⊗(Subscript[K, i])
Δ[((Subscript[K, i_])^(-1))]:=((Subscript[K, i])^(-1))⊗((Subscript[K, i])^(-1))
Δ[SuperPlus[(Subscript[X, i_])]]:=SuperPlus[(Subscript[X, i])]⊗(Subscript[K, i])+\[ScriptOne]⊗SuperPlus[(Subscript[X, i])]
Δ[SuperMinus[(Subscript[X, i_])]]:=SuperMinus[(Subscript[X, i])]⊗\[ScriptOne]+((Subscript[K, i])^(-1))⊗SuperMinus[(Subscript[X, i])]

Δ[α_?qNumberQ A_]:=α Δ[A]

Δ[A_**B_]:=Δ[A]**Δ[B]

Δop[Z_]:=Δ[Z]/.X_⊗Y_:>Y⊗X

Δ[X_Plus]:=Δ/@X
Δ[X_CircleTimes]:=Δ[First[X]]⊗Rest[X]

Weights of quantum group generators

OperatorWeight[Γ_][\[ScriptZero]]:=ZeroVector[Rank[Γ]]
OperatorWeight[Γ_][\[ScriptOne]]:=ZeroVector[Rank[Γ]]
OperatorWeight[Γ_][(Subscript[K, i_])]:=ZeroVector[Rank[Γ]]
OperatorWeight[Γ_][((Subscript[K, i_])^(-1))]:=ZeroVector[Rank[Γ]]

OperatorWeight[Γ_][SuperPlus[(Subscript[X, i_])]]:=OperatorWeight[Γ][SuperPlus[(Subscript[X, i])]]=SimpleRoots[Γ][[i]]
OperatorWeight[Γ_][SuperMinus[(Subscript[X, i_])]]:=OperatorWeight[Γ][SuperMinus[(Subscript[X, i])]]=-SimpleRoots[Γ][[i]]

OperatorWeight[Γ_][A_**B_]:=OperatorWeight[Γ][A]+OperatorWeight[Γ][B]

OperatorWeight[Γ_][A_⊗B_]:=OperatorWeight[Γ][A]+OperatorWeight[Γ][B]

OperatorWeight[Γ_][α_?qNumberQ A_]:=OperatorWeight[Γ][A]
(*OperatorWeight[Γ_][A_+B_]/;(OperatorWeight[Γ][A]==OperatorWeight[Γ][B]):=OperatorWeight[Γ][A]*)
OperatorWeight[Γ_][A_Plus]/;(Length[Union[OperatorWeight[Γ]/@(List@@A)]]==1):=OperatorWeight[Γ][First[A]]

OperatorLength[Γ_,A_]:=OperatorLength[Γ,A]=With[{λ=OperatorWeight[Γ][A]},(Sqrt[KillingForm[Γ][λ,λ]])]

(Subscript[K, ρ])

(Subscript[K, (Subscript[A, 1]),ρ])=(Subscript[K, 1]);
(Subscript[K, Γ_,ρ]):=Inner[NonCommutativePower,CartanGenerators[Γ],(Plus@@PositiveRoots[Γ]).Inverse[SimpleRoots[Γ]],NonCommutativeMultiply]

End[];

EndPackage[];