SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\HigherRank"];
Once[<<KnotTheory`];
<<Rot.m

{
{(Subscript[r, 0,pxx])[1,i_,j_],(Subscript[r, 0,pxx])[-1,i_,j_]},
{(Subscript[r, 1,ppx])[1,i_,j_],(Subscript[r, 1,ppx])[-1,i_,j_]},
{(Subscript[r, 1,rest])[1,i_,j_],(Subscript[r, 1,rest])[-1,i_,j_]},
(Subscript[γ, 1])[φ_,k_]
}=Get["px-data.m"]

(Subscript[r, 1,rest])[1,4,5]

{(SuperStar[p]),(SuperStar[x]),(SuperStar[π]),(SuperStar[ξ])}={π,ξ,p,x};  (SuperStar[((Subscript[u_, i__]))]):=(Subscript[((SuperStar[u])), i]);

(Subscript[Zip, {}])[ℰ_]:=ℰ;
(Subscript[Zip, {ζ_,ζs___}])[ℰ_] := (Collect[ℰ//(Subscript[Zip, {ζs}]),ζ] /. f_.(ζ^(d_.)):>(D[f,{(SuperStar[ζ]),d}]))/.(SuperStar[ζ])->0

px2g[ℰ_]:=Module[{ps,xs,Q},
ps=Union[Cases[ℰ,(Subscript[p, __]),∞]]; xs=Union[Cases[ℰ,(Subscript[x, __]),∞]];
Q=Sum[(SuperStar[p0]) (SuperStar[x0]) (Subscript[g, p0[[2]],x0[[2]],p0[[3]],x0[[3]]]),{p0,ps},{x0,xs}];
Expand[(Subscript[Zip, ps⋃xs])[ℰ (E^Q)]/.(Subscript[g, α_,β_,i_,j_]):>If[α===β,(Subscript[g, α,i,j]),0]]
]

px2g[ (Subscript[p, 2,j]^2) (Subscript[x, 2,i]) (Subscript[x, 2,j])]

(Subscript[R, 1])[1,i_,j_]=px2g[(Subscript[r, 1,rest])[1,i,j]]

(Subscript[R, 1])[-1,i_,j_]=px2g[(Subscript[r, 1,rest])[-1,i,j]]

px2g[(Subscript[r, 0,pxx])[1,i0,j0](Subscript[r, 1,ppx])[1,i1,j1]]

θ[{1,i0_,j0_},{1,i1_,j1_}]=px2g[(Subscript[r, 0,pxx])[1,i0,j0](Subscript[r, 1,ppx])[1,i1,j1]]
θ[{1,i0_,j0_},{-1,i1_,j1_}]=px2g[(Subscript[r, 0,pxx])[1,i0,j0](Subscript[r, 1,ppx])[-1,i1,j1]]
θ[{-1,i0_,j0_},{1,i1_,j1_}]=px2g[(Subscript[r, 0,pxx])[-1,i0,j0](Subscript[r, 1,ppx])[1,i1,j1]]
θ[{-1,i0_,j0_},{-1,i1_,j1_}]=px2g[(Subscript[r, 0,pxx])[-1,i0,j0](Subscript[r, 1,ppx])[-1,i1,j1]]

(Subscript[Γ, 1])[φ_,k_]=px2g[(Subscript[γ, 1])[φ,k]]

(Subscript[T, 3])=(Subscript[T, 1])(Subscript[T, 2]);
CF[ℰ_]:=Factor@Together[ℰ];
θ[K_]:=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,gEval,Y,yEval,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[ℰ_]:=CF[ℰ/.(Subscript[g, ν_,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, ν]))];
z=gEval[(∑_(k1=1)^n)(∑_(k2=1)^n)θ[Cs[[k1]],Cs[[k2]]]];
z+=gEval[(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]]];
z+=gEval[(∑_(k=1)^(2n))(Subscript[Γ, 1])[φ[[k]],k]];
{Δ,(Δ/.T->(Subscript[T, 1]))(Δ/.T->(Subscript[T, 2]))(Δ/.T->(Subscript[T, 3]))z}//CF
];

Timing[θ[Knot[3,1]]]

Timing[θ[Knot[4,1]]]

Timing[θ[Knot["K11n34"]]]

Timing[θ[Knot["K11n42"]]]

PD[GST48]=PD[X[1,15,2,14],X[29,2,30,3],X[40,4,41,3],X[4,44,5,43],X[5,26,6,27],X[95,7,96,6],X[7,1,8,96],X[8,14,9,13],X[28,9,29,10],X[41,11,42,10],X[11,43,12,42],X[12,27,13,28],X[15,31,16,30],X[61,16,62,17],X[72,17,73,18],X[83,18,84,19],X[34,20,35,19],X[20,89,21,90],X[92,21,93,22],X[22,79,23,80],X[23,68,24,69],X[24,57,25,58],X[56,25,57,26],X[31,63,32,62],X[32,74,33,73],X[33,85,34,84],X[35,50,36,51],X[81,37,82,36],X[70,38,71,37],X[59,39,60,38],X[54,39,55,40],X[55,45,56,44],X[45,59,46,58],X[46,70,47,69],X[47,81,48,80],X[91,49,92,48],X[49,91,50,90],X[82,52,83,51],X[71,53,72,52],X[60,54,61,53],X[74,63,75,64],X[85,64,86,65],X[65,76,66,77],X[66,87,67,88],X[94,67,95,68],X[86,75,87,76],X[77,88,78,89],X[93,78,94,79]];

AbsoluteTiming[gst48=θ[GST48]]

NumberOfKnots[10, Alternating] = 123
NumberOfKnots[11, Alternating] = 367
NumberOfKnots[12, Alternating] = 1288
NumberOfKnots[13, Alternating] = 4878
NumberOfKnots[14, Alternating] = 19536
NumberOfKnots[15, Alternating] = 85263
NumberOfKnots[16, Alternating] = 379799

NumberOfKnots[10, NonAlternating] = 42
NumberOfKnots[11, NonAlternating] = 185
NumberOfKnots[12, NonAlternating] = 888
NumberOfKnots[13, NonAlternating] = 5110
NumberOfKnots[14, NonAlternating] = 27436
NumberOfKnots[15, NonAlternating] = 168030
NumberOfKnots[16, NonAlternating] = 1008906

Monitor[
tab14=Table[K->θ@K,{K,AllKnots[{3,14}] }],
K]

Put[tab14/.{(Subscript[T, 1])->T1,(Subscript[T, 2])->T2}, "Data14.m"]

dup14=Map[First,Select[Gather[tab14,Last[#1]===Last[#2]&], Length[#]>1&],{2}]

Length/@dup14

Total[(Length/@dup14)-1]

dup14Q=Map[First,Select[Gather[tab14/.{(Subscript[T, 1])->I,(Subscript[T, 2])->I},Last[#1]===Last[#2]&], Length[#]>1&],{2}]

Total[(Length/@dup14Q)-1]

dup14Q=Map[First,Select[Gather[tab14/.{(Subscript[T, 1])->22/7,(Subscript[T, 2])->34/21},Last[#1]===Last[#2]&], Length[#]>1&],{2}]

Total[(Length/@dup14Q)-1]