KnotTheory`QuantumKnotInvariants` package

A subpackage for KnotTheory`, providing a simple interface to the QuantumGroups` package.
June 23, 2006, Scott Morrison

BeginPackage["KnotTheory`QuantumKnotInvariants`",{"KnotTheory`","QuantumGroups`","QuantumGroups`Braiding`","QuantumGroups`Representations`","QuantumGroups`Utilities`DataPackage`"}];

QuantumKnotInvariant::about="Quantum knot invariants are calculated using the mathematica package QuantumGroups`, written by Scott Morrison 2003-2008.";

QuantumKnotInvariant::usage="QuantumKnotInvariant[Γ, V][K][q] calculates the quantum knot invariant of the knot K in the representation V of the quantum group Γ. This relies on the QuantumGroups` package, and you should look there for details of how Γ and V may be specified.

Examples:
   QuantumKnotInvariant[Subscript[A,2], Irrep[Subscript[A,2]][{1, 0}]][Knot[5, 2]][q]
   QuantumKnotInvariant[Subscript[G,2], Irrep[Subscript[G,2]][{1, 0}]⊕Irrep[Subscript[G,2]][{0, 1}]][Knot[5, 2]][q]"

PackageQuantumKnotInvariants::usage="PackageQuantumKnotInvariants[Γ] saves all calculated quantum knot invariants for the quantum group K into a data file in the QuantumGroupsDataDirectory[]."

Begin["`Private`"]

q=Global`q;

Wants[x_]:=
(Off[Get::noopen];Off[Needs::nocont];Needs[x];On[Needs::nocont];On[Get::noopen];)

ExtractMatrices[indices:{__Integer},matrices_]:=Extract[matrices,indices/.{n_/;n<0:>{2,-n},n_/;n>0:>{1,n}}]

TogetherDot[x_]:=x
TogetherDot[x_,y_]:=x.y
TogetherDot[x_,y_,z__]:=TogetherDot[Together[x.y],z]

QuantumKnotInvariant[(Subscript[Γ_, n_]),V_][K_]:=QuantumKnotInvariant[(Subscript[Γ, n]),V][K]=Module[{br=BR[K],k,data},
CreditMessage[QuantumKnotInvariant::about];
If[br===BR[1,{}],
Return[Function[{Global`q0},Evaluate[qDimension[(Subscript[Γ, n])][V]/.q->Global`q0]]]
];
Wants["QuantumGroups`Data`"<>ToString[Γ]<>ToString[n]<>"`BraidingData`"];
k=br[[1]];
data=BraidingData[(Subscript[Γ, n])][V,k];
Function[{Global`q0},Evaluate[Expand[Together[Plus@@(#[[1]]Tr[TogetherDot@@ExtractMatrices[br[[2]],#[[2]]]]&)/@data]]/.q->Global`q0]]
]

PackageQuantumKnotInvariants[(Subscript[Γ_, n_])]:=PackageData[
{{QuantumKnotInvariant,HoldPattern[QuantumKnotInvariant[(Subscript[Γ, n]),_][_Knot]]}},
{ToString[Γ]<>ToString[n],"QuantumKnotInvariants"},
"Needs"->{"QuantumGroups`","KnotTheory`","KnotTheory`QuantumKnotInvariants`"},
"ExtraPrivateCode"->"q0=Global`q0;","UseGzip"->False
]

End[]

EndPackage[]