SetDirectory["~/AcademicPensieve/Projects/HigherRank/Data"];
(*SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\HigherRank\\Data"];*)
<<../../KnotTheory/KnotTheory/init.m
AppendTo[$Path,KnotTheoryDirectory[]="../../KnotTheory"];
Print[$Path=Cases[$Path, _String]];
<<../Rot.m
(Subscript[T, 3])=(Subscript[T, 1])(Subscript[T, 2]);

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[ℰ];
CCF[ℰ_] := Factor[ℰ];
CF[ℰ_List]:=CF/@ℰ;
CF[ℰ_] := Module[{vs=Cases[ℰ,(Subscript[(x|p|π|g), __]),∞]⋃{x,p,ϵ},ps,c},
Total[CoefficientRules[Expand[ℰ], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))] ];

Data

(from Talks/Beijing-2407/theta.nb)

(Subscript[R, 1])[1,i_,j_]=CF[
1/2-(Subscript[T, 3])(Subscript[g, 1,j,i])(Subscript[g, 2,j,i])-(Subscript[g, 3,i,i])+(Subscript[g, 2,j,j])(Subscript[g, 3,i,i])+(Subscript[T, 1])((Subscript[T, 3])-1)(Subscript[g, 1,j,i])(Subscript[g, 3,j,i])+(Subscript[T, 2])((Subscript[T, 3])-1)(Subscript[g, 2,j,i])(Subscript[g, 3,j,i])-(Subscript[T, 2])(Subscript[g, 2,j,i])(Subscript[g, 3,j,j])+((Subscript[g, 1,j,j])(Subscript[g, 2,i,i])+((Subscript[T, 3])-1)(Subscript[g, 1,j,j])(Subscript[g, 2,j,i])-(Subscript[T, 1])(Subscript[g, 1,i,i])(Subscript[g, 2,j,j])-(Subscript[g, 1,j,j])(Subscript[g, 3,i,i])-(Subscript[T, 1])((Subscript[T, 3])-1)(Subscript[g, 1,j,j])(Subscript[g, 3,j,i])+(Subscript[T, 1])(Subscript[g, 1,i,i])(Subscript[g, 3,j,j]))/((Subscript[T, 1])-1)];

(Subscript[R, 1])[-1,i_,j_]=CF[
-1/2-(Subscript[T, 1]^(-1))(Subscript[g, 1,j,i])(Subscript[g, 2,i,i])-(1-(Subscript[T, 1]^(-1))-(Subscript[T, 2]^(-1)))(Subscript[g, 1,j,i])(Subscript[g, 2,j,i])-(Subscript[g, 1,j,j])(Subscript[g, 2,j,i])-(Subscript[g, 1,j,i])(Subscript[g, 2,j,j])+(Subscript[g, 3,i,i])+(Subscript[T, 1]^(-1))(Subscript[g, 1,j,i])(Subscript[g, 3,i,i])-(1-(Subscript[T, 2]^(-1)))(Subscript[g, 2,j,i])(Subscript[g, 3,i,i])-(Subscript[g, 2,j,j])(Subscript[g, 3,i,i])+(1-(Subscript[T, 3]^(-1)))(Subscript[g, 1,j,i])(Subscript[g, 3,j,i])-(1-(Subscript[T, 3]^(-1)))(Subscript[g, 2,i,i])(Subscript[g, 3,j,i])+(2-(Subscript[T, 2]^(-1)))(1-(Subscript[T, 3]^(-1)))(Subscript[g, 2,j,i])(Subscript[g, 3,j,i])+(1-(Subscript[T, 3]^(-1)))(Subscript[g, 2,j,j])(Subscript[g, 3,j,i])+(Subscript[g, 1,j,i])(Subscript[g, 3,j,j])+(Subscript[g, 2,j,i])(Subscript[g, 3,j,j])+((Subscript[T, 1])(1-(Subscript[T, 2]^(-1)))(Subscript[g, 1,i,i])(Subscript[g, 2,j,i])-(Subscript[g, 1,j,j])(Subscript[g, 2,i,i])+(Subscript[T, 1])(Subscript[g, 1,i,i])(Subscript[g, 2,j,j])+(Subscript[g, 1,j,j])(Subscript[g, 3,i,i])-(Subscript[T, 2]^(-1))((Subscript[T, 3])-1)(Subscript[g, 1,i,i])(Subscript[g, 3,j,i])-(Subscript[T, 1])(Subscript[g, 1,i,i])(Subscript[g, 3,j,j]))/((Subscript[T, 1])-1)];

θ[{1,i0_,j0_},{1,i1_,j1_}]=-(Subscript[T, 1])((Subscript[T, 3])-1)(Subscript[g, 1,j1,i0])(Subscript[g, 2,i1,i0])(Subscript[g, 3,j0,i1])+((Subscript[T, 3])-1)(Subscript[g, 1,j1,j0])(Subscript[g, 2,i1,i0])(Subscript[g, 3,j0,i1])+(Subscript[T, 1])((Subscript[T, 3])-1)(Subscript[g, 1,j1,i0])(Subscript[g, 2,j1,i0])(Subscript[g, 3,j0,i1])-((Subscript[T, 3])-1)(Subscript[g, 1,j1,j0])(Subscript[g, 2,j1,i0])(Subscript[g, 3,j0,i1]);

θ[{1,i0_,j0_},{-1,i1_,j1_}]=((Subscript[T, 3])-1)(Subscript[g, 1,j1,i0])(Subscript[g, 2,i1,i0])(Subscript[g, 3,j0,i1])-(Subscript[T, 1]^(-1))((Subscript[T, 3])-1)(Subscript[g, 1,j1,j0])(Subscript[g, 2,i1,i0])(Subscript[g, 3,j0,i1])-((Subscript[T, 3])-1)(Subscript[g, 1,j1,i0])(Subscript[g, 2,j1,i0])(Subscript[g, 3,j0,i1])+(Subscript[T, 1]^(-1))((Subscript[T, 3])-1)(Subscript[g, 1,j1,j0])(Subscript[g, 2,j1,i0])(Subscript[g, 3,j0,i1]);

θ[{-1,i0_,j0_},{1,i1_,j1_}]=CF[
(Subscript[T, 1]^(-1))(Subscript[T, 2]^(-1))((Subscript[T, 3])-1)((Subscript[g, 1,j1,i0])(Subscript[g, 2,i1,i0])(Subscript[g, 3,j0,i1])-(Subscript[T, 1])(Subscript[g, 1,j1,j0])(Subscript[g, 2,i1,i0])(Subscript[g, 3,j0,i1])-(Subscript[g, 1,j1,i0])(Subscript[g, 2,j1,i0])(Subscript[g, 3,j0,i1])+(Subscript[T, 1])(Subscript[g, 1,j1,j0])(Subscript[g, 2,j1,i0])(Subscript[g, 3,j0,i1]))];

θ[{-1,i0_,j0_},{-1,i1_,j1_}]=CF[
(1-(Subscript[T, 3]^(-1))) (-(Subscript[T, 1]^(-1))(Subscript[g, 1,j1,i0]) (Subscript[g, 2,i1,i0]) (Subscript[g, 3,j0,i1])+(Subscript[g, 1,j1,j0]) (Subscript[g, 2,i1,i0]) (Subscript[g, 3,j0,i1])+(Subscript[T, 1]^(-1))(Subscript[g, 1,j1,i0]) (Subscript[g, 2,j1,i0]) (Subscript[g, 3,j0,i1])-(Subscript[g, 1,j1,j0]) (Subscript[g, 2,j1,i0]) (Subscript[g, 3,j0,i1]))];

(Subscript[Γ, 1])[φ_,k_]=-φ/2+φ (Subscript[g, 3,k,k]);

The Programs

θ[K_]:=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,ν,α,β,gEval,c,z},
{Cs,φ}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A];
G=Inverse[A]; gEval[ℰ_]:=Factor[ℰ/.(Subscript[g, ν_,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, ν]))];
z=gEval[Sum[θ[Cs[[k1]],Cs[[k2]]],{k1,n},{k2,n}]];
z+=gEval@Sum[(Subscript[R, 1])@@Cs[[k]],{k,n}];
z+=gEval@Sum[(Subscript[Γ, 1])[φ[[k]],k],{k,2n}];
{Δ,(Δ/.T->(Subscript[T, 1]))(Δ/.T->(Subscript[T, 2]))(Δ/.T->(Subscript[T, 3]))z}//Factor ];

θ[Knot[3,1]]

The Run

Table[n->NumberOfKnots[n], {n,3,15}]

AbsoluteTiming[
Table[Echo[K]->(θ[K]/.{(Subscript[T, 1])->T1,(Subscript[T, 2])->T2}),{K,AllKnots[{15,15}][[200001;;253293]]}] >> "theta15(200001-253293).m"
]

AbsoluteTiming[
Table[Echo[K]->HOMFLYPT[PD@K][a,z],{K,AllKnots[{3,15}]}] >> "HOMFLYPT3-15.m"
]

AbsoluteTiming[
Table[Echo[K]->Kh[PD@K][q,t],{K,AllKnots[{3,15}]}] >> "Data/Kh3-15.m"
]