Pensieve header: Computing $\rho_1$ for torus knots.

Preliminaries

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Oaxaca-2210"];

Once[<<KnotTheory`; <<Rot.m];

The Program

(Subscript[R, 1])[s_,i_,j_]:=s((Subscript[g, j,i])((Subscript[g, (SuperPlus[j]),j])+(Subscript[g, j,(SuperPlus[j])])-(Subscript[g, i,j]))-(Subscript[g, i,i])((Subscript[g, j,(SuperPlus[j])])-1)-1/2);
Z[K_]:=Z[K]=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,ρ1},
{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];
ρ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] - (∑_(k=1)^(2n))φ[[k]]((Subscript[g, k,k])-1/2);
Factor@{Δ,(Δ^2)ρ1/.(SuperPlus[α_]):>α+1/.(Subscript[g, α_,β_]):>G[[α,β]]}];

T2z[p_]:=Module[{q=Expand[p],n,c},
If[q===0,0,c=Coefficient[q,T,n=Exponent[q,T]];c (z^(2n))+T2z[q-c((((T^(1/2))-(T^(-1/2))))^(2n))]]];

T2z[p_]:=Module[{q=Expand[p],n,c},
If[q===0,0,c=Coefficient[q,T,n=Exponent[q,T]];c (z^(2n))+T2z[q-c((((T^(1/2))-(T^(-1/2))))^(2n))]]];

ren[p_]:=(T^(-Exponent[p,T,Min]))p;

The First Few Torus Knots

The format is: Two lines for each knot. The first is a pair {(Subscript[T, p,q]),Δ} where Δ is the Alexander polynomial. The following line is (Subscript[ρ, 1]), normalized to have no negative powers and to have its constant term non-zero.

tab=Table[ρz=Factor[ren/@Z[K]];
Echo@Column[{{(Subscript[T, K[[1]],K[[2]]]),ρz[[1]]},ρz[[2]]}],
{K,TorusKnots[36]}];