Pensieve header: Developing $\rho_d$.

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

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

<< "../../Projects/Profile/Profile.m"

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

{(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

(Subscript[γ, 1])[1,k_]:=ϵ ((1/2)-(Subscript[p, k]) (Subscript[x, k])); (Subscript[γ, 1])[-1,k_]:=ϵ (-(1/2)+(Subscript[p, k]) (Subscript[x, k]));

(Subscript[r, 1])[1,i_,j_]:=ϵ (-(1/2)+(Subscript[p, i]) (Subscript[x, i])-(Subscript[p, j]) (Subscript[x, i])+(1/2) (-1+T) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]^2)+(1/2) (1-T) (Subscript[p, j]^2) (Subscript[x, i]^2)-(Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])+(Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j]));
(Subscript[r, 1])[-1,i_,j_]:=ϵ ((1/2)-(Subscript[p, i]) (Subscript[x, i])+(Subscript[p, j]) (Subscript[x, i])+(((-1+T) (Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]^2))/(2 T))-(((-1+T) (Subscript[p, j]^2) (Subscript[x, i]^2))/(2 T))+(Subscript[p, i]) (Subscript[p, j]) (Subscript[x, i]) (Subscript[x, j])-(Subscript[p, j]^2) (Subscript[x, i]) (Subscript[x, j]));

(Subscript[γ, 2])[1,k_]:=-(1/2) (ϵ^2) (Subscript[p, k]) (Subscript[x, k])+ϵ ((1/2)-(Subscript[p, k]) (Subscript[x, k])); (Subscript[γ, 2])[-1,k_]:=-(1/2) (ϵ^2) (Subscript[p, k]) (Subscript[x, k])+ϵ (-(1/2)+(Subscript[p, k]) (Subscript[x, k]));

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

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

Module[{k,x1,x2,p1,p2},
(Subscript[γ, d_])[0,j_]:=0;
{(SuperStar[x1]),(SuperStar[x2]),(SuperStar[p1]),(SuperStar[p2])}={p1,p2,x1,x2};
(Subscript[r, d_])[s_,φi_,φj_,i_,j_]:=Normal[Log[((O[ϵ])^(d+1))+(Subscript[Zip, {x1,x2}])[Exp[((O[ϵ])^(d+1))+
((Subscript[γ, d])[φi,i]/.(Subscript[x, i])->(Subscript[x, i])+x1)+((Subscript[γ, d])[φj,j]/.(Subscript[x, j])->(Subscript[x, j])+x2)+((Subscript[r, d])[s,i,j]/.{(Subscript[p, i])->(Subscript[p, i])-p1,(Subscript[p, j])->(Subscript[p, j])-p2})
]]]]
];

(Subscript[ρ, d_])[K_]:=(Subscript[PP, ρd])@Module[{Cs,φ,n,A,s,i,j,k,Δ,G,ρd},
(Subscript[PP, "Green"])[
{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];
];
(Subscript[PP, Pairing])[
ρd=Times[
Series[Exp[Total@Cases[Cs,{s_,i_,j_}:>(Subscript[r, d])[s,φ[[i]],φ[[j]],i,j]]],{ϵ,0,d}]//Normal,
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,2n+1},{β,2n+1}]]
]//(Subscript[Zip, Join@@Table[{(Subscript[p, k]),(Subscript[x, k])},{k,2n+1}]]);
];
(Subscript[PP, Renormalizing])[ρd=CoefficientList[Δ Normal[Series[ρd,{ϵ,0,d}]]/.ϵ->Δ ϵ,ϵ,d+1]];
(Subscript[PP, Substitution])@Factor[ρd/.(SuperPlus[α_]):>α+1/.(Subscript[g, α_,β_]):>G[[α,β]]]
];

{(Subscript[ca, 1,2])=1,(Subscript[ca, 1,10])=-1,(Subscript[ca, 2,1])=0,(Subscript[cb, 2,10])=3/2};

Table[K->(Subscript[ρ, 1])[K], {K,AllKnots[{3,6}]}]

(Subscript[ρ, 2])[Knot[3,1]]

BeginProfile[]
Timing[z1=(Subscript[ρ, 2])[Knot[10,106]]]
PrintProfile[]

BeginProfile[]
Timing[z2=(Subscript[ρ, 2])[Knot[12, NonAlternating, 369]]]
PrintProfile[]

Simplify[Thread[z1==z2]]