RootsOfUnity package

A subpackage for QuantumGroups v2.
Version 2.0, September 18, 2008, Scott Morrison

Introduction

Implementation

BeginPackage["QuantumGroups`RootsOfUnity`",{"QuantumGroups`","QuantumGroups`RootSystems`"}];

AlcoveDefiningRoot;WeightInAlcoveQ;AlcoveWeights;AlcoveWeightsInLattice;AlcoveRoots;LevelFromRoot;RootFromLevel;

Begin["`Private`"];

AlcoveDefiningRoot[Γ_,l_]:=AlcoveDefiningRoot[Γ,l]=With[{lp=If[EvenQ[l],l/2,l]},
If[Divisible[lp,LacingNumber[Γ]],
LongDominantRoots[Γ][[1]],
ShortDominantRoots[Γ][[1]]]
]

WeightInAlcoveQ[Γ_,l_Integer][λ:{___Integer}]:=(And@@(NonNegative/@λ))∧(KillingForm[Γ][AlcoveDefiningRoot[Γ,l],λ+ρ[Γ]]<If[EvenQ[l],l/2,l])

AlcoveWeights[Γ_,l_]:=AlcoveWeights[Γ,l]=Module[{ar=AlcoveDefiningRoot[Γ,l],λ=ZeroVector[Rank[Γ]],p},
Reap[
While[
Sow[λ];
λ+=UnitVector[Rank[Γ],1];
While[¬ZeroVectorQ[λ]∧¬WeightInAlcoveQ[Γ,l][λ],
(* odometer *)
p=Position[λ,x_/;x>0][[1,1]];
λ[[p]]=0;
If[p<Rank[Γ],++λ[[p+1]]];
];
¬ZeroVectorQ[λ]
]
][[2,1]]
]

AlcoveWeightsInLattice[Γ_,l_,All]:=AlcoveWeights[Γ,l]

AlcoveWeightsInLattice[Γ_,l_,lattice_]:=AlcoveWeightsInLattice[Γ,l,lattice]=Cases[AlcoveWeights[Γ,l],λ_/;WeightInLatticeQ[Γ,λ,lattice]]

AlcoveRoots[Γ_,l_]:=AlcoveRoots[Γ,l]=Cases[AlcoveWeights[Γ,l],λ_/;RootWeightQ[Γ,λ]]

LevelFromRoot[Γ_,l_]:=(l/(2LacingNumber[Γ]))-DualCoxeterNumber[Γ]

RootFromLevel[Γ_,k_]:=2LacingNumber[Γ](k+DualCoxeterNumber[Γ])

AlcoveRoots[Γ_,l_]:=AlcoveRoots[Γ,l]=Cases[AlcoveWeights[Γ,l],λ_/;RootWeightQ[Γ,λ]]

TwistFactor[Γ_,Irrep[Γ_][λ_]]:=(Global`q^(KillingForm[Γ][λ,λ+2ρ[Γ]]))

End[];

EndPackage[];