KnotTheoryPathScott = "c:\\scott\\projects\\KnotTheory\\trunk\\";
KnotTheoryPathEmily="/Users/emilypeters/Documents/Math/Knot Theory/trunk";
AppendTo[$Path, KnotTheoryPathScott];
AppendTo[$Path, KnotTheoryPathEmily];
<< KnotTheory`

QuantumGroupsDataDirectory[]="c:\\scott\\projects\\QuantumGroups\\trunk\\data";
AppendTo[$Path,QuantumGroupsDataDirectory[]];

Clear[CheckIdentity]

CheckIdentity[n_/;2≤n≤3][K_]:=Module[{δ,q0,q,values},
δ=FullSimplify[(1/2)(∑_(i=-n+1)^(n-1))(E^((((2π I)/(8n-4)))(2i)))];
q0=q/.Solve[q+(q^(-1))==δ,q][[1]];
values=FullSimplify[{QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]],
2QuantumKnotInvariant[A1,Irrep[A1][{1}]][K][q0]}];
{values,FullSimplify[{1,-1}.values]==0}
]

CheckIdentity[n:4][K_]:=Module[{values},
values={QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][q],
2Simplify[QuantumKnotInvariant[A2,Irrep[A2][{1,0}]][K][q]/qDimension[A2][Irrep[A2][{1,0}]]],
2Simplify[QuantumKnotInvariant[A3,Irrep[A3][{1,0,0}]][K][q]/qDimension[A3][Irrep[A3][{1,0,0}]]],
2Expand[HOMFLYPT[K][a,z]],
2Expand[HOMFLYPT[K][(q^3),q-(q^(-1))]],
2Expand[HOMFLYPT[K][(q^4),q-(q^(-1))]],
QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]],
2QuantumKnotInvariant[A2,Irrep[A2][{1,0}]][K][Exp[((2 π I)/14)]],
2QuantumKnotInvariant[A3,Irrep[A3][{1,0,0}]][K][Exp[-((2 π I)/14)]]};
{values,FullSimplify[{0,0,0,0,0,0,1,-1,0}.values]==0,FullSimplify[{0,0,0,0,0,0,1,0,-1}.values]==0}
]

CheckIdentity[n:5][K_]:=Module[{values},
values=FullSimplify[{QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]],
2QuantumKnotInvariant[A3,Irrep[A3][{1,0,0}]][K][Exp[((2 π I)/18)]]}];
{values,FullSimplify[{1,-1}.values]==0}
]

CheckIdentity[2]/@AllKnots[{3,6}]

CheckIdentity[3]/@AllKnots[{3,6}]

Clear[f]
f[K_]:=f[K]=q/.Solve[Last@CheckIdentity[4][K],q]

CheckIdentity[4][Knot[0,1]]

CheckIdentity[4][Knot[3,1]]

CheckIdentity[4][Knot[4,1]]

CheckIdentity[4]/@AllKnots[5]

FullSimplify[f[Knot[0,1]]]

N@%

CheckIdentity[4]/@AllKnots[{3,6}]

CheckIdentity[5][Knot[0,1]]

N@(CheckIdentity[5]/@AllKnots[{3,4}])

N[%]

f[Knot[3,1]]

Solve[{Last@CheckIdentity[4][Knot[3,1]],Last@CheckIdentity[4][K]},q]

f[Knot[5,2]]

Cases[Chop[Flatten[Outer[{#1,Abs[#1-#2]}&,f[Knot[3,1]],f[Knot[5,2]]],1]],{_,0}]

q/.N@Solve[Last@CheckIdentity[4][Knot[3,1]],q]

q/.N@Solve[Last@CheckIdentity[4][Knot[4,1]],q]

N@CheckIdentity[4][BR[3,{1,1,2}]]

N@CheckIdentity[4][BR[4,{1,1,2,3}]]

N@CheckIdentity[4][BR[4,{1,2,1,3}]]

CheckIdentity[4]/@AllKnots[{3,3}]

N[%]

CheckIdentity[5]/@AllKnots[{3,3}]

CheckNewIdentity[n_][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]]-2QuantumKnotInvariant[A1,Irrep[A1][{n-1}]][K][Exp[(((-1))^n)((2 π I)/(4n-2))]]]

CheckNewIdentity[2][Knot[4,1]]

CheckNewIdentity[3][Knot[4,1]]

CheckNewIdentity[4][Knot[4,1]]

N[%]

CheckNewIdentity[n_][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]]-2QuantumKnotInvariant[A1,Irrep[A1][{n-2}]][K][Exp[(((-1))^n)((2 π I)/(4n-2))]]]

CheckNewIdentity[3][Knot[4,1]]

CheckNewIdentity[4][Knot[4,1]]

N[%]

CheckNewIdentity[n_][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]]-2QuantumKnotInvariant[(Subscript[A, n-2]),Irrep[(Subscript[A, n-2])][UnitVector[n-2,1]]][K][Exp[(((-1))^n)((2 π I)/(4n-2))]]]

CheckNewIdentity[3][Knot[3,1]]

CheckNewIdentity[4][Knot[3,1]]

N[%]

CheckNewIdentity[5][Knot[3,1]]

N[%]

Clear[CheckNewIdentity]

CheckNewIdentity[n:4][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]]-2QuantumKnotInvariant[(Subscript[A, 3]),Irrep[(Subscript[A, 3])][{1,0,0}]][K][Exp[-((2 π I)/(4n-2))]]]

CheckNewIdentity[n_/;n≥5][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]]-2QuantumKnotInvariant[(Subscript[D, n-1]),Irrep[(Subscript[D, n-1])][UnitVector[n-1,n-1]]][K][Exp[-((2 π I)/(4n-2))]]]

CheckNewIdentity[4][Knot[0,1]]

CheckNewIdentity[4][Knot[3,1]]

CheckNewIdentity[4][Knot[4,1]]

CheckNewIdentity[4][Knot[5,1]]

CheckNewIdentity[5][Knot[0,1]]

CheckNewIdentity[6][Knot[0,1]]

CheckNewIdentity[5][Knot[3,1]]

CheckNewIdentity[5][Knot[4,1]]

CheckNewIdentity[5][Knot[5,1]]

CheckNewIdentity[5][Knot[5,2]]

CheckNewIdentity[6][Knot[3,1]]

CheckNewIdentity[6][Knot[5,1]]

CheckNewIdentity[6][Knot[4,1]]

From page 1682 of Scott' s notes :

CheckNewIdentity2[n:5][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{2}]][K][Exp[((2 π I)/(8n-4))]]-QuantumKnotInvariant[(Subscript[D, n-1]),Irrep[(Subscript[D, n-1])][{0,0,2,0}]][K][Exp[-((2 π I)/(4n-2))]]]

CheckNewIdentity2[5][Knot[3,1]]

CheckNewIdentity2[5][Knot[4,1]]

CheckNewIdentity2[5][Knot[5,1]]

CheckNewIdentity2[5][Knot[5,2]]

CheckNewIdentity3[n_/;n≥5][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]]-2QuantumKnotInvariant[(Subscript[D, n-1]),Irrep[(Subscript[D, n-1])][2UnitVector[n-1,n-2]]][K][Exp[-((2 π I)/(4n-2))]]]

CheckNewIdentity3[5][Knot[3,1]]

CheckNewIdentity3[5][Knot[4,1]]

CheckNewIdentity3[5][Knot[5,1]]

CheckNewIdentity3[6][Knot[3,1]]

Table[N@FullSimplify[(1/2)qDimension[A1][Irrep[A1][{2n-2}]]/.q->Exp[((2 π I)/(8n-4))]],{n,5,8}]

Table[N@FullSimplify[qDimension[(Subscript[D, n-1])][Irrep[(Subscript[D, n-1])][UnitVector[n-1,n-1]]]/.q->Exp[((2 π I)/(4n-2))]],{n,5,8}]

Table[N@FullSimplify[qDimension[(Subscript[D, n-1])][Irrep[(Subscript[D, n-1])][2UnitVector[n-1,n-1]]]/.q->Exp[((2 π I)/(4n-2))]],{n,5,8}]

Expand[DualCoxeterNumber[(Subscript[D, n-1])]]

Table[N@FullSimplify[qDimension[(Subscript[D, n-1])][Irrep[(Subscript[D, n-1])][3UnitVector[n-1,n-1]]]/.q->1],{n,5,8}]

Table[N@FullSimplify[qDimension[(Subscript[D, n-1])][Irrep[(Subscript[D, n-1])][3UnitVector[n-1,n-1]]]/.q->Exp[((2 π I)/(4n-2))]],{n,5,8}]

FullSimplify[qDimension[A1][Irrep[A1][{12}]]/.q->Exp[((2 π I)/(8*7-4))]]

FullSimplify[(qDimension[A1][Irrep[A1][{12}]]/.q->Exp[((2 π I)/(8*7-4))])-(2qDimension[G2][Irrep[G2][{1,0}]]/.q->Exp[2π I(3/26)])]

CheckG2Identity[n:7][K_]:=N[QuantumKnotInvariant[A1,Irrep[A1][{2n-2}]][K][Exp[((2 π I)/(8n-4))]]-2QuantumKnotInvariant[G2,Irrep[G2][{1,0}]][K][Exp[2π I(23/26)]]]

Chop[CheckG2Identity[7][Knot[0,1]]]

Chop[CheckG2Identity[7][Knot[3,1]]]

Chop[CheckG2Identity[7][Knot[5,1]]]

Chop[CheckG2Identity[7][Knot[4,1]]]

List@@DecomposeRepresentation[G2][((Irrep[G2][{1,0}])^(⊗2))]

qDimension[G2]/@%

Chop[N[%/.q->Exp[2π I(23/26)]]]

Table[Chop[N[qDimension[A1][Irrep[A1][{k}]]/.q->Exp[((2 π I)/(8*7-4))]]],{k,0,12}]

CheckG2Identity2[n:7][K_]:=FullSimplify[QuantumKnotInvariant[A1,Irrep[A1][{4}]][K][Exp[((2 π I)/(8n-4))]]-QuantumKnotInvariant[G2,Irrep[G2][{0,1}]][K][Exp[2π I(23/26)]]]

CheckG2Identity2[7][Knot[0,1]]

CheckG2Identity2[7][Knot[3,1]]

CheckG2Identity2[7][Knot[5,1]]

CheckG2Identity2[7][Knot[4,1]]

CheckG2Identity2[7][Knot[8,19]]

CheckG2Identity2[7]/@AllKnots[{0,5}]

CheckG2Identity2[7]/@AllKnots[{0,5}]

AllKnots[3]

CheckG2Identity2[7]/@Cases[AllKnots[{0,10}],k_/;First[BR[k]]<4]

CheckG2Identity2[7]/@Cases[AllKnots[{0,11}],k_/;First[BR[k]]<4]

CheckG2Identity2[7]/@Cases[AllLinks[{2,8}],k_/;First[BR[k]]<4]

CheckG2Identity2[7][Link[2,Alternating,1]]

CheckG2

List@@DecomposeRepresentation[G2][((Irrep[G2][{0,1}])^(⊗2))]

qDimension[G2]/@%

Chop[N[%/.q->Exp[2π I(23/26)]]]

CheckG2Identity3[n:7][K_]:=N[QuantumKnotInvariant[A1,Irrep[A1][{2}]][K][Exp[((2 π I)/(8n-4))]]-QuantumKnotInvariant[G2,Irrep[G2][{0,2}]][K][Exp[2π I(23/26)]]]

Chop[CheckG2Identity3[7][Knot[0,1]]]

qDimension[G2][Irrep[G2][{0,2}]]/.q->1

Chop[CheckG2Identity3[7][Knot[3,1]]]

Chop[CheckG2Identity2[7][Knot[5,1]]]

Chop[CheckG2Identity2[7][Knot[4,1]]]