Pensieve header: The positivity of $\rho_d$ for positive knots. Continues pensieve://Projects/APAI/APAI-Positivity.nb.

Preliminaries

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Oaxaca-2210"];
Once[<<KnotTheory`; <<Rot.m];

(Subscript[ρ, d])

V@(Subscript[γ, 1,φ_])[k_]=φ (1/2-(Subscript[(OverBar[p]), k]) (Subscript[(OverBar[x]), k])); V@(Subscript[γ, 2,φ_])[k_]=-(φ^2)(Subscript[(OverBar[p]), k]) (Subscript[(OverBar[x]), k])/2; V@(Subscript[γ, 3,φ_])[k_]:=-(φ^3) (Subscript[(OverBar[p]), k]) (Subscript[(OverBar[x]), k])/6

V@(Subscript[r, 1,s_])[i_,j_]:=s (-1+2 (Subscript[p, i]) (Subscript[x, i])-2 (Subscript[p, j]) (Subscript[x, i])+(-1+(T^s)) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]^2)+(1-(T^s)) (Subscript[p, j]^2) (Subscript[x, i]^2)-2 (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])+2 (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j]))/2

V@(Subscript[r, 2,1])[i_,j_]:=(-6 (Subscript[p, i]) (Subscript[x, i])+6 (Subscript[p, j]) (Subscript[x, i])-3 (-1+3 T) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]^2)+3 (-1+3 T) (Subscript[p, j]^2) (Subscript[x, i]^2)+4 (-1+T) (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^3)-2 (-1+T) (5+T) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^3)+2 (-1+T) (3+T) (Subscript[p, j]^3) (Subscript[x, i]^3)+18 (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])-18 (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j])-6 (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^2) (Subscript[x, j])+6 (2+T) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^2) (Subscript[x, j])-6 (1+T) (Subscript[p, j]^3) (Subscript[x, i]^2) (Subscript[x, j])-6 (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j]^2)+6 (Subscript[p, j]^3) (Subscript[x, i]) (Subscript[x, j]^2))/12

V@(Subscript[r, 2,-1])[i_,j_]:=(-6 (T^2) (Subscript[p, i]) (Subscript[x, i])+6 (T^2) (Subscript[p, j]) (Subscript[x, i])+3 (-3+T) T (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]^2)-3 (-3+T) T (Subscript[p, j]^2) (Subscript[x, i]^2)-4 (-1+T) T (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^3)+2 (-1+T) (1+5 T) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^3)-2 (-1+T) (1+3 T) (Subscript[p, j]^3) (Subscript[x, i]^3)+18 (T^2) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])-18 (T^2) (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j])-6 (T^2) (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^2) (Subscript[x, j])+6 T (1+2 T) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^2) (Subscript[x, j])-6 T (1+T) (Subscript[p, j]^3) (Subscript[x, i]^2) (Subscript[x, j])-6 (T^2) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j]^2)+6 (T^2) (Subscript[p, j]^3) (Subscript[x, i]) (Subscript[x, j]^2))/(12(T^2))

V@(Subscript[r, 3,1])[i_,j_]:=(4 (Subscript[p, i]) (Subscript[x, i])-4 (Subscript[p, j]) (Subscript[x, i])+2 (5+7 T) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]^2)-2 (5+7 T) (Subscript[p, j]^2) (Subscript[x, i]^2)-4 (-5+6 T) (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^3)+4 (-16+17 T+2 (T^2)) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^3)-4 (-11+11 T+2 (T^2)) (Subscript[p, j]^3) (Subscript[x, i]^3)+3 (-1+T) (Subscript[p, i]^3) (Subscript[p, j]) (Subscript[x, i]^4)-3 (-1+T) (4+3 T) (Subscript[p, i]^2) (Subscript[p, j]^2) (Subscript[x, i]^4)+(-1+T) (13+22 T+(T^2)) (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]^4)-(-1+T) (4+13 T+(T^2)) (Subscript[p, j]^4) (Subscript[x, i]^4)-28 (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])+28 (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j])+36 (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^2) (Subscript[x, j])-12 (9+2 T) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^2) (Subscript[x, j])+24 (3+T) (Subscript[p, j]^3) (Subscript[x, i]^2) (Subscript[x, j])-4 (Subscript[p, i]^3) (Subscript[p, j]) (Subscript[x, i]^3) (Subscript[x, j])+28 T (Subscript[p, i]^2) (Subscript[p, j]^2) (Subscript[x, i]^3) (Subscript[x, j])-4 (-6+17 T+(T^2)) (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]^3) (Subscript[x, j])+4 (-5+10 T+(T^2)) (Subscript[p, j]^4) (Subscript[x, i]^3) (Subscript[x, j])+24 (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j]^2)-24 (Subscript[p, j]^3) (Subscript[x, i]) (Subscript[x, j]^2)-24 (Subscript[p, i]^2) (Subscript[p, j]^2) (Subscript[x, i]^2) (Subscript[x, j]^2)+6 (10+T) (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]^2) (Subscript[x, j]^2)-6 (6+T) (Subscript[p, j]^4) (Subscript[x, i]^2) (Subscript[x, j]^2)-4 (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]) (Subscript[x, j]^3)+4 (Subscript[p, j]^4) (Subscript[x, i]) (Subscript[x, j]^3))/24

V@(Subscript[r, 3,-1])[i_,j_]:=(-4 (T^3) (Subscript[p, i]) (Subscript[x, i])+4 (T^3) (Subscript[p, j]) (Subscript[x, i])-2 (T^2) (7+5 T) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]^2)+2 (T^2) (7+5 T) (Subscript[p, j]^2) (Subscript[x, i]^2)-4 (T^2) (-6+5 T) (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^3)+4 T (-2-17 T+16 (T^2)) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^3)-4 T (-2-11 T+11 (T^2)) (Subscript[p, j]^3) (Subscript[x, i]^3)+3 (-1+T) (T^2) (Subscript[p, i]^3) (Subscript[p, j]) (Subscript[x, i]^4)-3 (-1+T) T (3+4 T) (Subscript[p, i]^2) (Subscript[p, j]^2) (Subscript[x, i]^4)+(-1+T) (1+22 T+13 (T^2)) (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]^4)-(-1+T) (1+13 T+4 (T^2)) (Subscript[p, j]^4) (Subscript[x, i]^4)+28 (T^3) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])-28 (T^3) (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j])-36 (T^3) (Subscript[p, i]^2) (Subscript[p, j]) (Subscript[x, i]^2) (Subscript[x, j])+12 (T^2) (2+9 T) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]^2) (Subscript[x, j])-24 (T^2) (1+3 T) (Subscript[p, j]^3) (Subscript[x, i]^2) (Subscript[x, j])+4 (T^3) (Subscript[p, i]^3) (Subscript[p, j]) (Subscript[x, i]^3) (Subscript[x, j])-28 (T^2) (Subscript[p, i]^2) (Subscript[p, j]^2) (Subscript[x, i]^3) (Subscript[x, j])-4 T (-1-17 T+6 (T^2)) (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]^3) (Subscript[x, j])+4 T (-1-10 T+5 (T^2)) (Subscript[p, j]^4) (Subscript[x, i]^3) (Subscript[x, j])-24 (T^3) (Subscript[p, i]) (Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j]^2)+24 (T^3) (Subscript[p, j]^3) (Subscript[x, i]) (Subscript[x, j]^2)+24 (T^3) (Subscript[p, i]^2) (Subscript[p, j]^2) (Subscript[x, i]^2) (Subscript[x, j]^2)-6 (T^2) (1+10 T) (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]^2) (Subscript[x, j]^2)+6 (T^2) (1+6 T) (Subscript[p, j]^4) (Subscript[x, i]^2) (Subscript[x, j]^2)+4 (T^3) (Subscript[p, i]) (Subscript[p, j]^3) (Subscript[x, i]) (Subscript[x, j]^3)-4 (T^3) (Subscript[p, j]^4) (Subscript[x, i]) (Subscript[x, j]^3))/(24(T^3))

{(SuperStar[p]),(SuperStar[x]),(SuperStar[(OverBar[p])]),(SuperStar[(OverBar[x])])}={π,ξ,(OverBar[π]),(OverBar[ξ])};  (SuperStar[((Subscript[z_, i__]))]):=(Subscript[((SuperStar[z])), i]);
(Subscript[Zip, {}])[ℰ_]:=ℰ;
(Subscript[Zip, {z_,zs___}])[ℰ_] := (Collect[ℰ//(Subscript[Zip, {zs}]),z] /. f_.(z^(d_.)):>(D[f,{(SuperStar[z]),d}]))/.(SuperStar[z])->0

gPair[fs_,w_]:=gPair[fs,w]=Collect[(Subscript[Zip, Join@@Table[{(Subscript[p, α]),(Subscript[(OverBar[p]), α]),(Subscript[x, α]),(Subscript[(OverBar[x]), α])},{α,w}]])[(Times@@(V/@fs))Exp[Sum[(Subscript[g, α,β])((Subscript[π, α])+(Subscript[(OverBar[π]), α]))((Subscript[ξ, β])+(Subscript[(OverBar[ξ]), β])),{α,w},{β,w}]-Sum[(Subscript[(OverBar[ξ]), α])(Subscript[π, α]),{α,w}]]],(Subscript[g, __]),Factor]

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))]]];

(Subscript[Z, d_])[K_]:=(Subscript[Z, d])[K]= Module[{Cs,φ,n,A,s,i,j,k,Δ,G,d1,Z1,Z2,Z3},
{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}})))];
{Δ,G}=Factor@{(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det@A,Inverse@A};
Z1=Exp[Total[Cases[Cs,{s_,i_,j_}:>Sum[(ϵ^d1)(Subscript[r, d1,s])[i,j],{d1,d}]]]+ Sum[(ϵ^d1)(Subscript[γ, d1,φ[[k]]])[k], {k,2n},{d1,d}]/.(Subscript[γ, _,0])[_]->0];
Z2=Expand[F[{},{}]×Normal@Series[Z1,{ϵ,0,d}]]//.F[fs_,{es___}]×(((f:(Subscript[(r|γ), ps__])[is__]))^(p_.)):>F[Join[fs,Table[f,p]],DeleteDuplicates@{es,is}];
Z3=Expand[Z2/.F[fs_,es_]:>Expand[gPair[
Replace[fs,Thread[es->Range@Length@es],{2}],Length@es
]/.(Subscript[g, α_,β_]):>G[[es[[α]],es[[β]]]]] ];
Collect[{Δ,Z3/.(ϵ^(p_.))->p!(Δ^(2p))(ϵ^p)},ϵ,T2z] ];

(Subscript[Z, 3])[Knot[3,1]]//Timing

(Subscript[Z, 3])[PD@Knot[3,1]]//Timing

Positivity

(((T-1))^2)/T//T2z

(* Copied from KnotInfo by Roland *)
PosBraidKnots={Knot[3,1],Knot[5,1],Knot[7,1],Knot[8,19],Knot[9,1],Knot[10,124],Knot[10,139],Knot[10,152],Knot[11,Alternating,367],Knot[11,NonAlternating,77],Knot[12,NonAlternating,242],Knot[12,NonAlternating,472],Knot[12,NonAlternating,574],Knot[12,NonAlternating,679],Knot[12,NonAlternating,688],Knot[12,NonAlternating,725],Knot[12,NonAlternating,888]};

tab2=Table[Echo[K->(Subscript[Z, 2])[K]], {K, PosBraidKnots}]

tab3=Table[Echo[K->(Subscript[Z, 3])[K]], {K, PosBraidKnots}]