Introducing the q-Casimir w to all orders and expressing and computing the invariant in terms of it.

Pensieve header: The “Speedy” engine.

Once[<<KnotTheory`];

(Subscript[PP, _])=Identity; $k=2;γ=1;ℏ=1;

The “Speedy” Engine

Internal Utilities

Canonical Form:

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[
Expand[ℰ] //. (E^(x_))(E^(y_)):>(E^(x+y)) /. (E^(x_)):>(E^(CCF[x]))];
CF[ℰ_List]:=CF/@ℰ;
CF[sd_SeriesData] := MapAt[CF,sd,3];
CF[ℰ_] := Module[
{vs=Cases[ℰ,(Subscript[(y|b|t|a|w|x|η|β|τ|α|ω|ξ), _]),∞]⋃{y,b,t,a,w,x,η,β,τ,α,ω,ξ}},
Total[CoefficientRules[Expand[ℰ], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))]
];
CF[ℰ_𝔼]:=CF/@ℰ; CF[(Subscript[𝔼, sp___])[ℰs___]]:=CF/@(Subscript[𝔼, sp])[ℰs];

The Kronecker δ:

Kδ/:(Subscript[Kδ, i_,j_]):=If[i===j,1,0];

Equality, multiplication, and degree-adjustment of perturbed Gaussians; 𝔼[L,Q,P] stands for (e^(L+Q))P:

𝔼/:𝔼[L1_,Q1_,P1_]≡𝔼[L2_,Q2_,P2_]:=CF[L1==L2]∧CF[Q1==Q2]∧CF[Normal[P1-P2]==0];
𝔼/:𝔼[L1_,Q1_,P1_]𝔼[L2_,Q2_,P2_]:=𝔼[L1+L2,Q1+Q2,P1*P2];
(Subscript[𝔼[L_,Q_,P_], $k_]):=𝔼[L,Q,Series[Normal@P,{ϵ,0,$k}]];

Zip and Bind

Variables and their duals:

{(SuperStar[t]),(SuperStar[b]),(SuperStar[y]),(SuperStar[a]),(SuperStar[w]),(SuperStar[x]),(SuperStar[z])}={τ,β,η,α,ω,ξ,ζ}; 
{(SuperStar[τ]),(SuperStar[β]),(SuperStar[η]),(SuperStar[α]),(SuperStar[ω]),(SuperStar[ξ]),(SuperStar[ζ])}={t,b,y,a,w,x,z}; (SuperStar[((Subscript[u_, i_]))]):=(Subscript[((SuperStar[u])), i]);

Upper to lower and lower to Upper:

U2l={(Subscript[B, i_]^(p_.)):>(E^(-p ℏ γ (Subscript[b, i]))),(B^(p_.)):>(E^(-p ℏ γ b)), (Subscript[T, i_]^(p_.)):>(E^(-p ℏ (Subscript[t, i]))),(T^(p_.)):>(E^(-p ℏ t)),(Subscript[𝒜, i_]^(p_.)):>(E^(p γ (Subscript[α, i]))),(𝒜^(p_.)):>(E^(p γ α)),(Subscript[Ω, i_]^(p_.)):>(E^(p  (Subscript[ω, i]))),(Ω^(p_.)):>(E^(p  ω))}; 
l2U={(E^(c_.(Subscript[b, i_])+d_.)):>(Subscript[B, i]^(-c/(ℏ γ)))(E^d),(E^(c_.b+d_.)):>(B^(-c/(ℏ γ)))(E^d),
(E^(c_.(Subscript[t, i_])+d_.)):>(Subscript[T, i]^(-c/ℏ))(E^d),(E^(c_.t+d_.)):>(T^(-c/ℏ))(E^d),
(E^(c_.(Subscript[α, i_])+d_.)):>(Subscript[𝒜, i]^(c/γ))(E^d),(E^(c_.α+d_.)):>(𝒜^(c/γ))(E^d),
(E^(c_.(Subscript[ω, i_])+d_.)):>(Subscript[Ω, i]^c)(E^d),(E^(c_.ω+d_.)):>(Ω^c)(E^d),
(E^(ℰ_)):>(E^(Expand@ℰ))};

Derivatives in the presence of exponentiated variables:

(Subscript[D, b])[f_]:=(∂_b)f-ℏ γ B(∂_B)f; (Subscript[D, (Subscript[b, i_])])[f_]:=(∂_(Subscript[b, i]))f-ℏ γ (Subscript[B, i])(∂_(Subscript[B, i]))f;
(Subscript[D, t])[f_]:=(∂_t)f-ℏ T(∂_T)f; (Subscript[D, (Subscript[t, i_])])[f_]:=(∂_(Subscript[t, i]))f-ℏ (Subscript[T, i])(∂_(Subscript[T, i]))f; 
(Subscript[D, α])[f_]:=(∂_α)f+γ 𝒜 (∂_𝒜)f; (Subscript[D, (Subscript[α, i_])])[f_]:=(∂_(Subscript[α, i]))f+γ (Subscript[𝒜, i]) (∂_(Subscript[𝒜, i]))f;
(Subscript[D, ω])[f_]:=(∂_ω)f+ Ω (∂_Ω)f; (Subscript[D, (Subscript[ω, i_])])[f_]:=(∂_(Subscript[ω, i]))f+ (Subscript[Ω, i]) (∂_(Subscript[Ω, i]))f;
(Subscript[D, v_])[f_]:=(∂_v)f; (Subscript[D, {v_,0}])[f_]:=f; (Subscript[D, {}])[f_]:=f; (Subscript[D, {v_,n_Integer}])[f_]:=(Subscript[D, v])[(Subscript[D, {v,n-1}])[f]];
(Subscript[D, {l_List,ls___}])[f_]:=(Subscript[D, {ls}])[(Subscript[D, l])[f]];

Finite Zips:

collect[sd_SeriesData, ζ_] := MapAt[collect[#,ζ]&,sd,3];
collect[ℰ_,ζ_] := Collect[ℰ,ζ];
(Subscript[Zip, {}])[P_]:=P;
(Subscript[Zip, ζs_])[Ps_List]:=(Subscript[Zip, ζs])/@Ps;
(Subscript[Zip, {ζ_,ζs___}])[P_] := 
(collect[P//(Subscript[Zip, {ζs}]),ζ] /. f_.(ζ^(d_.)):>((Subscript[D, {(SuperStar[ζ]),d}])[f]))/.(SuperStar[ζ])->0/.(((SuperStar[ζ])/.{b->B,t->T,α->𝒜,ω->Ω})->1)

QZip implements the “Q-level zips” on 𝔼(L,Q,P)=(e^(L+Q))P(ϵ). Such zips regard the L variables as scalars.

(Subscript[QZip, ζs_List])@𝔼[L_,Q_,P_] := Module[{ζ,z,zs,c,ys,ηs,qt,zrule,ζrule,out},
zs=Table[(SuperStar[ζ]),{ζ,ζs}];
c=CF[Q/.Alternatives@@(ζs⋃zs)->0];
ys=CF@Table[(∂_ζ)(Q/.Alternatives@@zs->0),{ζ,ζs}];
ηs=CF@Table[(∂_z)(Q/.Alternatives@@ζs->0),{z,zs}];
qt=CF@Inverse@Table[(Subscript[Kδ, z,(SuperStar[ζ])])-(∂_(z,ζ))Q,{ζ,ζs},{z,zs}];
zrule=Thread[zs->CF[qt.(zs+ys)]];
ζrule=Thread[ζs->ζs+ηs.qt];
CF /@ 𝔼[L,c+ηs.qt.ys,Det[qt](Subscript[Zip, ζs])[P/.(zrule⋃ζrule)]] ];

LZip implements the “L-level zips” on 𝔼(L,Q,P)=((Pe)^(L+Q)). Such zips regard all of ((Pe)^Q) as a single”P”. Here the z’s are b and α and the ζ’s are β and a.

(Subscript[LZip, ζs_List])@𝔼[L_,Q_,P_] := Module[{ζ,z,zs,Zs,c,ys,ηs,lt,zrule,Zrule,ζrule,Q1,EEQ,EQ},
zs=Table[(SuperStar[ζ]),{ζ,ζs}];
Zs=zs/.{b->B,t->T,α->𝒜,ω->Ω};
c=L/.Alternatives@@(ζs⋃zs)->0/.Alternatives@@Zs->1;
ys=Table[(∂_ζ)(L/.Alternatives@@zs->0),{ζ,ζs}];
ηs=Table[(∂_z)(L/.Alternatives@@ζs->0),{z,zs}];
lt=Inverse@Table[(Subscript[Kδ, z,(SuperStar[ζ])])-(∂_(z,ζ))L,{ζ,ζs},{z,zs}];
zrule=Thread[zs->lt.(zs+ys)];
Zrule=Join[zrule,zrule/.r_Rule:>((U=r[[1]]/.{b->B,t->T,α->𝒜,ω->Ω})->(U/.U2l/.r//.l2U))];
ζrule=Thread[ζs->ζs+ηs.lt];
Q1=Q/.(Zrule⋃ζrule);
EEQ[ps___]:=EEQ[ps]=(CF[(E^(-Q1))(Subscript[D, Thread[{zs,{ps}}]])[(E^Q1)]]/.{Alternatives@@zs->0,Alternatives@@Zs->1});
CF@𝔼[c+ηs.lt.ys,Q1/.{Alternatives@@zs->0,Alternatives@@Zs->1},
Det[lt]((Subscript[Zip, ζs])[(EQ@@zs)(P/.(Zrule⋃ζrule))] /. Derivative[ps___][EQ][___] :> EEQ[ps] /. _EQ->1)  ] ];

(Subscript[TZip, ζs_List])@𝔼[L_,Q_,P_] := Module[{ζ,z,zs,Zs,c,ys,ηs,lt,zrule,Zrule,ζrule,Q1,EEQ,EQ,Lnew=L,Qnew=Q,Pnew=P},
zrule = Table[(SuperStar[ζ])->Coefficient[L,ζ],{ζ,ζs}];
ζrule = Table[ζ->0,{ζ,ζs}];
Lnew=L/.U2l/.zrule/.ζrule;
Qnew=Q/.U2l/.zrule/.ζrule;(**)
Pnew=P/.U2l/.zrule/.ζrule;
(𝔼[Lnew,Qnew,Pnew]//.l2U)
];

(Subscript[B, {}])[L_,R_]:=L R;
(Subscript[B, {is__}])[L_𝔼,R_𝔼] := Module[{n},
Times[
L/.Table[(Subscript[(v:b|B|t|T|a|w|x|y), i])->(Subscript[v, n@i]),{i,{is}}],
R/.Table[(Subscript[(v:β|τ|α|𝒜|ω|Ω|ξ|η), i])->(Subscript[v, n@i]),{i,{is}}]
]// (Subscript[TZip, Join@@Table[{(Subscript[τ, n@i])},{i,{is}}]]) // (Subscript[LZip, Join@@Table[{(Subscript[w, n@i]),(Subscript[β, n@i]),(Subscript[a, n@i])},{i,{is}}]]) // (Subscript[QZip, Join@@Table[{(Subscript[ξ, n@i]),(Subscript[y, n@i])},{i,{is}}]]) ];(**)
(Subscript[B, is___])[L_,R_]:=(Subscript[B, {is}])[L,R];

𝔼 morphisms with domain and range.

(Subscript[B, is_List])[(Subscript[𝔼, d1_->r1_])[L1_,Q1_,P1_],(Subscript[𝔼, d2_->r2_])[L2_,Q2_,P2_]]:=(Subscript[𝔼, (d1⋃Complement[d2,is])->(r2⋃Complement[r1,is])])@@(Subscript[B, is])[𝔼[L1,Q1,P1],𝔼[L2,Q2,P2]];
(Subscript[𝔼, d1_->r1_])[L1_,Q1_,P1_]//(Subscript[𝔼, d2_->r2_])[L2_,Q2_,P2_] := (Subscript[B, r1⋂d2])[(Subscript[𝔼, d1->r1])[L1,Q1,P1],(Subscript[𝔼, d2->r2])[L2,Q2,P2]];
(Subscript[𝔼, d1_->r1_])[L1_,Q1_,P1_]≡(Subscript[𝔼, d2_->r2_])[L2_,Q2_,P2_] ^:= (d1==d2)∧(r1==r2)∧(𝔼[L1,Q1,P1]≡𝔼[L2,Q2,P2]);
(Subscript[𝔼, d1_->r1_])[L1_,Q1_,P1_](Subscript[𝔼, d2_->r2_])[L2_,Q2_,P2_] ^:= (Subscript[𝔼, (d1⋃d2)->(r1⋃r2)])@@(𝔼[L1,Q1,P1]𝔼[L2,Q2,P2]);
(Subscript[(Subscript[𝔼, dr_])[L_,Q_,P_], $k_]):=(Subscript[𝔼, dr])@@(Subscript[𝔼[L,Q,P], $k]);
(Subscript[𝔼, _])[ℰ___][i_]:={ℰ}[[i]];

𝔼[Λ]

(Subscript[𝔼, dr_])[Λ_]:=CF@Module[{L,Λ0=Limit[Λ,ϵ->0]},(Subscript[(Subscript[𝔼, dr])[L=Λ0 /. (Subscript[(η|y|ξ|x), _])->0,Λ0-L,(E^(Λ-Λ0))], $k])/.l2U]

“Define” Code

Define[lhs=rhs, ...] defines the lhs to be rhs, except that rhs is computed only once for each value of $k. Fancy Mathematica not for the faint of heart. Most readers should ignore.

SetAttributes[Define, HoldAll];
Define[def_,defs__] := (Define[def]; Define[defs];);
Define[(Subscript[op_, is__])=ℰ_] := Module[{SD,ii,jj,kk,isp,nis,nisp,sis},Block[{i,j,k},
ReleaseHold[Hold[
SD[(Subscript[op, nisp,$k_Integer]),Block[{i,j,k},(Subscript[op, isp,$k])=ℰ;(Subscript[op, nis,$k])]];
SD[(Subscript[op, isp]),(Subscript[op, {is},$k])]; SD[(Subscript[op, sis__]),(Subscript[op, {sis}])];
]/. {SD->SetDelayed,
isp->{is}/.{i->i_,j->j_,k->k_},
nis->{is}/.{i->ii,j->jj,k->kk},
nisp->{is}/.{i->ii_,j->jj_,k->kk_}
}]  ]]

Symmetric Algebra Objects

(Subscript[sm, i_,j_->k_]):=(Subscript[𝔼, {i,j}->{k}])[(Subscript[b, k])((Subscript[β, i])+(Subscript[β, j]))+(Subscript[t, k])((Subscript[τ, i])+(Subscript[τ, j]))+(Subscript[a, k])((Subscript[α, i])+(Subscript[α, j]))+(Subscript[y, k])((Subscript[η, i])+(Subscript[η, j]))+(Subscript[x, k])((Subscript[ξ, i])+(Subscript[ξ, j]))];
(Subscript[sΔ, i_->j_,k_]):=(Subscript[𝔼, {i}->{j,k}])[(Subscript[β, i])((Subscript[b, j])+(Subscript[b, k]))+(Subscript[τ, i])((Subscript[t, j])+(Subscript[t, k]))+(Subscript[α, i])((Subscript[a, j])+(Subscript[a, k]))+(Subscript[η, i])((Subscript[y, j])+(Subscript[y, k]))+(Subscript[ξ, i])((Subscript[x, j])+(Subscript[x, k]))];
(Subscript[sS, i_]):=(Subscript[𝔼, {i}->{i}])[-(Subscript[β, i])(Subscript[b, i])-(Subscript[τ, i])(Subscript[t, i])-(Subscript[α, i])(Subscript[a, i])-(Subscript[η, i])(Subscript[y, i])-(Subscript[ξ, i])(Subscript[x, i])];
(Subscript[sϵ, i_]):=(Subscript[𝔼, {}->{i}])[0];(Subscript[sη, i_]):=(Subscript[𝔼, {i}->{}])[0];

(Subscript[sσ, i_->j_]):=(Subscript[𝔼, {i}->{j}])[(Subscript[β, i])(Subscript[b, j])+(Subscript[τ, i])(Subscript[t, j])+(Subscript[α, i])(Subscript[a, j])+(Subscript[η, i])(Subscript[y, j])+(Subscript[ξ, i])(Subscript[x, j])];
(Subscript[sΥ, i_->j_,k_,l_,m_]):=(Subscript[𝔼, {i}->{j,k,l,m}])[(Subscript[β, i])(Subscript[b, k])+(Subscript[τ, i])(Subscript[t, k])+(Subscript[α, i])(Subscript[a, l])+(Subscript[η, i])(Subscript[y, j])+(Subscript[ξ, i])(Subscript[x, m])];

Booting Up QU

Define[(Subscript[aσ, i->j])=(Subscript[𝔼, {i}->{j}])[(Subscript[a, j]) (Subscript[α, i])+(Subscript[x, j]) (Subscript[ξ, i])],(Subscript[bσ, i->j])=(Subscript[𝔼, {i}->{j}])[(Subscript[b, j]) (Subscript[β, i])+(Subscript[y, j]) (Subscript[η, i])]]

Define[(Subscript[am, i,j->k])=(Subscript[𝔼, {i,j}->{k}])[((Subscript[α, i])+(Subscript[α, j]))(Subscript[a, k])+((Subscript[𝒜, j]^(-1))(Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k])],
(Subscript[bm, i,j->k])=(Subscript[𝔼, {i,j}->{k}])[((Subscript[β, i])+(Subscript[β, j]))(Subscript[b, k])+((Subscript[η, i])+(E^(- ϵ (Subscript[β, i])))(Subscript[η, j]))(Subscript[y, k])]]

Three types of inverses appear below!
(OverBar[R]) is the inverse of R in the algebra 𝔹⊗𝔸.
P is the inverse of R as a quadratic form, like how an element of (SuperStar[V])⊗(SuperStar[V]) can be the inverse of an element of V⊗V.
(OverBar[aS]) is the inverse of aS as an operator form, like how an element of (SuperStar[V])⊗V can be the inverse of another element of (SuperStar[V])⊗V.

Define[(Subscript[R, i,j])=(Subscript[𝔼, {}->{i,j}])[ℏ (Subscript[a, j]) (Subscript[b, i])+(∑_(k=1)^($k+1)) (((((1-(E^(γ ϵ ℏ))))^k)(((ℏ (Subscript[y, i])(Subscript[x, j])))^k))/(k(1-(E^(k γ ϵ ℏ)))))],
(Subscript[(OverBar[R]), i,j])=CF@(Subscript[𝔼, {}->{i,j}])[-ℏ (Subscript[a, j]) (Subscript[b, i]),-ℏ (Subscript[x, j]) (Subscript[y, i])/(Subscript[B, i]),1+If[$k==0, 0,(Subscript[((Subscript[(OverBar[R]), {i,j},$k-1])), $k])[3]-
(((Subscript[((Subscript[(OverBar[R]), {i,j},0])), $k])(Subscript[R, 1,2])(Subscript[((Subscript[(OverBar[R]), {3,4},$k-1])), $k]))//((Subscript[bm, i,1->i])(Subscript[am, j,2->j]))//((Subscript[bm, i,3->i])(Subscript[am, j,4->j])))[3]]],
(Subscript[P, i,j])=(Subscript[𝔼, {i,j}->{}])[(Subscript[β, i])(Subscript[α, j])/ℏ,(Subscript[η, i])(Subscript[ξ, j])/ℏ,1+If[$k==0,0,(Subscript[((Subscript[P, {i,j},$k-1])), $k])[3]-
((Subscript[R, 1,2])//((Subscript[((Subscript[P, {1,j},0])), $k])(Subscript[((Subscript[P, {i,2},$k-1])), $k])))[3]]]]

Define[(Subscript[aS, i])=((Subscript[aσ, i->2])(Subscript[(OverBar[R]), 1,i]))//(Subscript[P, 1,2]),
(Subscript[(OverBar[aS]), i])=(Subscript[𝔼, {i}->{i}])[-(Subscript[a, i]) (Subscript[α, i]),-(Subscript[x, i]) (Subscript[𝒜, i]) (Subscript[ξ, i]),1+If[$k==0, 0,(Subscript[((Subscript[(OverBar[aS]), {i},$k-1])), $k])[3]-
((Subscript[((Subscript[(OverBar[aS]), {i},0])), $k])//(Subscript[aS, i])//(Subscript[((Subscript[(OverBar[aS]), {i},$k-1])), $k]))[3]]]]

(was (Subscript[aS, j])=(Subscript[(OverBar[R]), i,j])~(Subscript[B, i])~(Subscript[P, i,j])).

Define[(Subscript[bS, i])=(Subscript[bσ, i->1])(Subscript[R, i,2])//(Subscript[aS, 2])//(Subscript[P, 1,2]),
(Subscript[(OverBar[bS]), i])=(Subscript[bσ, i->1])(Subscript[R, i,2])//(Subscript[(OverBar[aS]), 2])//(Subscript[P, 1,2]),
(Subscript[aΔ, i->j,k])=((Subscript[R, 1,j])(Subscript[R, 2,k]))//(Subscript[bm, 1,2->3])//(Subscript[P, 3,i]),
(Subscript[bΔ, i->j,k])=((Subscript[R, j,1])(Subscript[R, k,2]))//(Subscript[am, 1,2->3])//(Subscript[P, i,3])]

(was (Subscript[bS, i])=(Subscript[R, i,1])~(Subscript[B, 1])~(Subscript[aS, 1])~(Subscript[B, 1])~(Subscript[P, i,1]),(Subscript[(OverBar[bS]), i])=(Subscript[R, i,1])~(Subscript[B, 1])~(Subscript[(OverBar[aS]), 1])~(Subscript[B, 1])~(Subscript[P, i,1])).

The Drinfel’d double:

Define[(Subscript[dm, i,j->k])=(((Subscript[sΥ, i->4,4,1,1])//(Subscript[aΔ, 1->1,2])//(Subscript[aΔ, 2->2,3])//(Subscript[(OverBar[aS]), 3]))((Subscript[sΥ, j->-1,-1,-4,-4])//(Subscript[bΔ, -1->-1,-2])//(Subscript[bΔ, -2->-2,-3])))//((Subscript[P, -1,3])(Subscript[P, -3,1])(Subscript[am, 2,-4->k])(Subscript[bm, 4,-2->k]))]

Define[(Subscript[dσ, i->j])=(Subscript[aσ, i->j])(Subscript[bσ, i->j]),
(Subscript[dϵ, i])=(Subscript[sϵ, i]), (Subscript[dη, i])=(Subscript[sη, i]),
(Subscript[dS, i])=(Subscript[sΥ, i->1,1,2,2])//((Subscript[(OverBar[bS]), 1])(Subscript[aS, 2]))//(Subscript[dm, 2,1->i]),
(Subscript[(OverBar[dS]), i])=(Subscript[sΥ, i->1,1,2,2])//((Subscript[bS, 1])(Subscript[(OverBar[aS]), 2]))//(Subscript[dm, 2,1->i]),
(Subscript[dΔ, i->j,k])=((Subscript[bΔ, i->3,1])(Subscript[aΔ, i->2,4]))//((Subscript[dm, 3,4->k])(Subscript[dm, 1,2->j]))]

Define[(Subscript[C, i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(1/2))(E^(-ℏ ϵ (Subscript[a, i])/2))], $k]),
(Subscript[(OverBar[C]), i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(-1/2))(E^(ℏ ϵ (Subscript[a, i])/2))], $k]),
(Subscript[c, i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(1/4))(E^(-ℏ ϵ (Subscript[a, i])/4))], $k]),
(Subscript[(OverBar[c]), i])=(Subscript[(Subscript[𝔼, {}->{i}])[0,0,(Subscript[B, i]^(-1/4))(E^(ℏ ϵ (Subscript[a, i])/4))], $k]),
(Subscript[Kink, i]) = ((Subscript[R, 1,3])(Subscript[(OverBar[C]), 2]))//(Subscript[dm, 1,2->1])//(Subscript[dm, 1,3->i]),
(Subscript[(OverBar[Kink]), i]) = ((Subscript[(OverBar[R]), 1,3])(Subscript[C, 2]))//(Subscript[dm, 1,2->1])//(Subscript[dm, 1,3->i]),
(Subscript[ρ, i])=((Subscript[c, 1])(Subscript[(OverBar[c]), 3])(Subscript[dS, i]))//(Subscript[dm, 1,i->i])//(Subscript[dm, i,3->i])](*ρ reverses a strand*)

Note. t=-ϵa+γb and b=t/γ+ϵa/γ

Define[(Subscript[b2t, i])=(Subscript[𝔼, {i}->{i}])[(Subscript[α, i])(Subscript[a, i])+(Subscript[β, i])(ϵ (Subscript[a, i])+(Subscript[t, i]))/γ+(Subscript[ξ, i])(Subscript[x, i])+(Subscript[η, i])(Subscript[y, i])],
(Subscript[t2b, i])=(Subscript[𝔼, {i}->{i}])[(Subscript[α, i])(Subscript[a, i])+(Subscript[τ, i])(-ϵ (Subscript[a, i])+γ (Subscript[b, i]))+(Subscript[ξ, i])(Subscript[x, i])+(Subscript[η, i])(Subscript[y, i])]]

The t-Tensors

Define[(Subscript[tR, i,j])=(Subscript[R, i,j])//((Subscript[b2t, i])(Subscript[b2t, j])),
(Subscript[(OverBar[tR]), i,j])=(Subscript[(OverBar[R]), i,j])//((Subscript[b2t, i])(Subscript[b2t, j])) ,
(Subscript[tm, i,j->k])=(((Subscript[t2b, i])(Subscript[t2b, j]))//(Subscript[dm, i,j->k])//(Subscript[b2t, k]) ),
(Subscript[tC, i])=((Subscript[C, i])//(Subscript[b2t, i]) ),
(Subscript[(OverBar[tC]), i])=((Subscript[(OverBar[C]), i])//(Subscript[b2t, i]) ),
(Subscript[tKink, i])=(Subscript[Kink, i])//(Subscript[b2t, i]) ,
(Subscript[(OverBar[tKink]), i])=(Subscript[(OverBar[Kink]), i])//(Subscript[b2t, i]) ,
(Subscript[tΔ, i->j,k])=(Subscript[t2b, i])//(Subscript[dΔ, i->j,k])//((Subscript[b2t, j])(Subscript[b2t, k])),
(Subscript[tS, i])=(Subscript[t2b, i])//(Subscript[dS, i])//(Subscript[b2t, i])]

(Subscript[tΔ, i->j,k])//(Subscript[tS, k])//(Subscript[tm, j,k->i])

((Subscript[(OverBar[tKink]), 8])(Subscript[(OverBar[tKink]), 9])(Subscript[(OverBar[tKink]), 10]) (Subscript[tR, 5,1])(Subscript[tR, 2,6])(Subscript[tR, 7,3])(Subscript[tC, 4])//(Subscript[tm, 1,2->1])//(Subscript[tm, 1,3->1])//(Subscript[tm, 1,4->1])//(Subscript[tm, 1,5->1])//(Subscript[tm, 1,6->1])//(Subscript[tm, 1,7->1])//(Subscript[tm, 1,8->1])//(Subscript[tm, 1,9->1])//(Subscript[tm, 1,10->1]))//.l2U//CF

The Knot Tensors

Define[(Subscript[kR, i,j])=((Subscript[R, i,j])//((Subscript[b2t, i])(Subscript[b2t, j])) /. (Subscript[t, i|j])->t)//.l2U//CF,
(Subscript[(OverBar[kR]), i,j])=((Subscript[(OverBar[R]), i,j])//((Subscript[b2t, i])(Subscript[b2t, j])) /. {(Subscript[t, i|j])->t,(Subscript[T, i|j])->T})//.l2U//CF,
(Subscript[km, i,j->k])=((((Subscript[t2b, i])(Subscript[t2b, j]))//(Subscript[dm, i,j->k])//(Subscript[b2t, k]) )/. {(Subscript[t, k])->t, (Subscript[T, k])->T,(Subscript[τ, i|j])->0})//.l2U//CF,
(Subscript[kC, i])=(((Subscript[C, i])//(Subscript[b2t, i]) )/. (Subscript[T, i])->T)//.l2U//CF,
(Subscript[(OverBar[kC]), i])=(((Subscript[(OverBar[C]), i])//(Subscript[b2t, i]) )/. (Subscript[T, i])->T)//.l2U//CF,
(Subscript[kKink, i])=((Subscript[Kink, i])//(Subscript[b2t, i]) /. {(Subscript[t, i])->t, (Subscript[T, i])->T})//.l2U//CF,
(Subscript[(OverBar[kKink]), i])=((Subscript[(OverBar[Kink]), i])//(Subscript[b2t, i]) /. {(Subscript[t, i])->t, (Subscript[T, i])->T})//.l2U//CF]

(Subscript[R, i,j])

(Subscript[kR, i,j])

(Subscript[kKink, 1])

(Subscript[(OverBar[kKink]), 8])(Subscript[(OverBar[kKink]), 9])(Subscript[(OverBar[kKink]), 10]) (Subscript[kR, 5,1])(Subscript[kR, 2,6])(Subscript[kR, 7,3])(Subscript[kC, 4])//(Subscript[km, 1,2->1])//(Subscript[km, 1,3->1])//(Subscript[km, 1,4->1])//(Subscript[km, 1,5->1])//(Subscript[km, 1,6->1])//(Subscript[km, 1,7->1])//(Subscript[km, 1,8->1])//(Subscript[km, 1,9->1])//(Subscript[km, 1,10->1])//Timing

a2w and w2a and q-Casimir

CenteqSol1={};CenteqSol2={};KinkSol1={};KinkSol2={};

(*Working Casimir, not unique! But has the right specialization when ϵ=0.*)

(Subscript[Cas, i_]):=(Subscript[𝔼, {}->{i}])[0,0,Series[y (E^(ϵ ℏ a))x+((  (E^(ℏ ϵ (a+1)))+(E^(-ℏ ϵ a))T)/(ℏ((E^(ℏ ϵ))-1)))-((1+T)/(ℏ((E^(ℏ ϵ))-1)))-((1+T)/2)+ϵ Sum[(Subscript[θ1, u,v])(y^v)(a^(u-v))(x^v),{u,0,2},{v,0,u}]+(ϵ^2) Sum[(Subscript[θ2, u,v])(y^v)(a^(u-v))(x^v),{u,0,4},{v,0,u}],{ϵ,0,$k}]/.CenteqSol1/.CenteqSol2/.KinkSol1/.{a->(Subscript[a, i]),T->T,x->(Subscript[x, i]),y->(Subscript[y, i])}]
(Subscript[Cas, i])

θ1s=Flatten@Table[(Subscript[θ1, u,v]),{u,0,2},{v,0,u}]
θ2s=Flatten@Table[(Subscript[θ2, u,v]),{u,0,4},{v,0,u}]

((Subscript[Cas, i])//(Subscript[km, i,j->k]))≡((Subscript[Cas, i])//(Subscript[km, j,i->k]))
Centeq1=%[[1]];

CenteqSol1=Solve[Thread[{Coefficient[Centeq1,ϵ  ((Subscript[y, k])^2)((Subscript[η, j])^2)]
,Coefficient[Centeq1,ϵ (Subscript[a, k]) (Subscript[y, k])(Subscript[η, j])],
Coefficient[Centeq1,ϵ (Subscript[y, k])(Subscript[η, j])]/.(Subscript[a, k])->0,
Coefficient[Centeq1,ϵ ((Subscript[𝒜, j])^(-1))  ((Subscript[y, k])^2)(Subscript[x, k ])(Subscript[η, j])]}==0],θ1s][[1]]

((Subscript[Cas, i])//(Subscript[km, i,j->k]))≡((Subscript[Cas, i])//(Subscript[km, j,i->k]));
Centeq2=%[[1]]//Simplify//Numerator//Expand

Thread[{Coefficient[Centeq2,(ϵ^2)(Subscript[x, k]^2) (Subscript[y, k]^3) (Subscript[η, j])]/.(Subscript[𝒜, j])->0,

Coefficient[Centeq2,(ϵ^2) ((Subscript[y, k])^4)(Subscript[𝒜, j]^3)((Subscript[η, j])^4)],
Coefficient[Centeq2,(ϵ^2)  ((Subscript[y, k])^4)(Subscript[x, k])(Subscript[𝒜, j]^2) (Subscript[η, j]^3)],
Coefficient[Centeq2,(ϵ^2)  ((Subscript[y, k])^3)(Subscript[𝒜, j]^2) (Subscript[η, j]^2)(Subscript[x, k])(Subscript[a, k])],
Coefficient[Centeq2,(ϵ^2)(Subscript[y, k]^3) (Subscript[x, k]^2) (Subscript[a, k])(Subscript[𝒜, j]) (Subscript[η, j])],
Coefficient[Centeq2,(ϵ^2)  ((Subscript[y, k])^3)(Subscript[x, k]^2) (Subscript[𝒜, j]) (Subscript[η, j])]/.(Subscript[a, k])->0,
Coefficient[Centeq2,(ϵ^2) (Subscript[a, k])((Subscript[y, k])^2)(Subscript[x, k])(Subscript[𝒜, j]^2)(Subscript[η, j])],
Coefficient[Centeq2,(ϵ^2) (Subscript[𝒜, j]^3) (Subscript[a, k]) (Subscript[y, k])(Subscript[η, j])],
Coefficient[Centeq2,(ϵ^2) (Subscript[y, k])(Subscript[η, j])(Subscript[𝒜, j]^3)]/.(Subscript[a, k])->0,
Coefficient[Centeq2,(ϵ^2) ((Subscript[y, k])^2)(Subscript[𝒜, j]^2)(Subscript[x, k])(Subscript[η, j])]/.(Subscript[a, k])->0,
Coefficient[Centeq2,(ϵ^2) ((Subscript[a, k])^2)(Subscript[y, k]) (Subscript[𝒜, j]^3) (Subscript[η, j])]}==0]

CenteqSol2=Solve[Thread[{Coefficient[Centeq2,(ϵ^2)(Subscript[x, k]^2) (Subscript[y, k]^3) (Subscript[η, j])],

Coefficient[Centeq2,(ϵ^2) ((Subscript[y, k])^4)(Subscript[𝒜, j]^3)((Subscript[η, j])^4)],
Coefficient[Centeq2,(ϵ^2)  ((Subscript[y, k])^4)(Subscript[x, k])(Subscript[𝒜, j]^2) (Subscript[η, j]^3)],
Coefficient[Centeq2,(ϵ^2)  ((Subscript[y, k])^3)(Subscript[𝒜, j]^2) (Subscript[η, j]^2)(Subscript[x, k])(Subscript[a, k])],
Coefficient[Centeq2,(ϵ^2)(Subscript[y, k]^3) (Subscript[x, k]^2) (Subscript[a, k])(Subscript[𝒜, j]) (Subscript[η, j])],
Coefficient[Centeq2,(ϵ^2)  ((Subscript[y, k])^3)(Subscript[x, k]^2) (Subscript[𝒜, j]) (Subscript[η, j])]/.(Subscript[a, k])->0,
Coefficient[Centeq2,(ϵ^2) (Subscript[a, k])((Subscript[y, k])^2)(Subscript[x, k])(Subscript[𝒜, j]^2)(Subscript[η, j])],
Coefficient[Centeq2,(ϵ^2) (Subscript[𝒜, j]^3) (Subscript[a, k]) (Subscript[y, k])(Subscript[η, j])],
Coefficient[Centeq2,(ϵ^2) (Subscript[y, k])(Subscript[η, j])(Subscript[𝒜, j]^3)]/.(Subscript[a, k])->0,
Coefficient[Centeq2,(ϵ^2) ((Subscript[y, k])^2)(Subscript[𝒜, j]^2)(Subscript[x, k])(Subscript[η, j])]/.(Subscript[a, k])->0,
Coefficient[Centeq2,(ϵ^2) ((Subscript[a, k])^2)(Subscript[y, k]) (Subscript[𝒜, j]^3) (Subscript[η, j])]}==0],θ2s][[1]]

((Subscript[Cas, i])//(Subscript[km, i,j->k]))≡((Subscript[Cas, i])//(Subscript[km, j,i->k]))

(Subscript[Φ, 1])[λ]=Sum[(Subscript[ϕ, u,v])[λ]((Subscript[y, i])^v)((Subscript[a, i])^(u-v))((Subscript[x, i])^v),{u,0,2},{v,0,u}]
Φ[λ]=1+ϵ (Subscript[Φ, 1])[λ]
ϕs=Flatten@ Table[(Subscript[ϕ, u,v])[λ],{u,0,2},{v,0,u}]

eqns1=Select[CoefficientRules[Coefficient[(∂_λ)Φ[λ]+((∂_λ)((1-T)((1/2)+(Subscript[a, i]))λ+((((E^(λ(1-T)))-1))/(1-T))(E^(-(1-T)λ))(Subscript[y, i])(Subscript[x, i])))Φ[λ]-(((Subscript[𝔼, {}->{i}])[(1-T)((1/2)+(Subscript[a, i]))λ,((((E^(λ(1-T)))-1))/(1-T))(E^(-(1-T)λ))(Subscript[y, i])(Subscript[x, i]),Φ[λ] ](Subscript[Cas, j]))//(Subscript[km, i,j->i]))[[3]],ϵ],{(Subscript[y, i]),(Subscript[a, i]),(Subscript[x, i])}],(#[[1,1]]+2#[[1,2]]+#[[1,1]])≤4&]/.(u_->v_):>(v==0)//.U2l//Simplify

Φ[λ]=Φ[λ]/.DSolve[Join[Table[(f/.λ->0)==0,{f,ϕs}],eqns1],ϕs,λ][[1]]

Expw1=((Subscript[𝔼, {i}->{i}])[(1-T)((Subscript[a, i])+(1/2))(Subscript[ω, i]),((((E^((Subscript[ω, i])(1-T)))-1))/(1-T))(E^(-(1-T)(Subscript[ω, i])))(Subscript[y, i])(Subscript[x, i]),Φ[λ]]/.(Subscript[ω, i])->(t/(1-T))/.λ->(t/(1-T))//Simplify)//.l2U//Simplify

(Subscript[kKink, i])

Coefficient[Expw1[[3]],(Subscript[x, i]^2) (Subscript[y, i]^2)ϵ]==(T^(1/2))Coefficient[(Subscript[kKink, i])[[3]],(Subscript[x, i]^2) (Subscript[y, i]^2)ϵ]
Coefficient[Expw1[[3]],(Subscript[a, i]^2)ϵ]==(T^(1/2))Coefficient[(Subscript[kKink, i])[[3]],(Subscript[a, i]^2)ϵ]
(Coefficient[Expw1[[3]],(Subscript[a, i])ϵ]/.(Subscript[x, i])->0)==(T^(1/2))Coefficient[(Subscript[kKink, i])[[3]],(Subscript[a, i])ϵ]
(Coefficient[Expw1[[3]],((Subscript[a, i])^2)ϵ]/.(Subscript[x, i])->0)==(T^(1/2))Coefficient[(Subscript[kKink, i])[[3]],((Subscript[a, i])^2)ϵ]
(Coefficient[Expw1[[3]],ϵ]/.{(Subscript[a, i])->0,(Subscript[x, i])->0})==(T^(1/2))Coefficient[(Subscript[kKink, i])[[3]],((Subscript[a, i])^2)ϵ]

KinkSol1=Solve[{(Coefficient[Expw1[[3]],(Subscript[a, i])ϵ]/.(Subscript[x, i])->0)==(T^(1/2))Coefficient[(Subscript[kKink, i])[[3]],(Subscript[a, i])ϵ],
(Coefficient[Expw1[[3]],((Subscript[a, i])^2)ϵ]/.(Subscript[x, i])->0)==(T^(1/2))Coefficient[(Subscript[kKink, i])[[3]],((Subscript[a, i])^2)ϵ],
(Coefficient[Expw1[[3]],ϵ]/.{(Subscript[a, i])->0,(Subscript[x, i])->0})==0},{(Subscript[θ1, 0,0]),(Subscript[θ1, 1,1]),(Subscript[θ1, 2,0])}][[1]]

Expw1/.KinkSol1//.U2l//Simplify

(Subscript[Cas, i])/.KinkSol1

Φ[λ]=Φ[λ]/.CenteqSol1/.KinkSol1//.l2U

Collect[Φ[λ]//.l2U//Simplify,ϵ]

(Subscript[Cas, 1])

(Subscript[Φ, 2])[λ]=Sum[(Subscript[ϕ, u,v])[λ]((Subscript[y, i])^v)((Subscript[a, i])^(u-v))((Subscript[x, i])^v),{u,0,4},{v,0,u}]
Φ[λ]+=(ϵ^2)(Subscript[Φ, 2])[λ]
ϕs=Flatten@ Table[(Subscript[ϕ, u,v])[λ],{u,0,4},{v,0,u}]

Φ[λ]=Φ[λ]//.U2l

eq2=(∂_λ)Φ[λ]+((∂_λ)((1-T)((1/2)+(Subscript[a, i]))λ+((((E^(λ(1-T)))-1))/(1-T))(E^(-(1-T)λ))(Subscript[y, i])(Subscript[x, i])))Φ[λ]-(((Subscript[𝔼, {}->{i}])[(1-T)((1/2)+(Subscript[a, i]))λ,((((E^(λ(1-T)))-1))/(1-T))(E^(-(1-T)λ))(Subscript[y, i])(Subscript[x, i]),Φ[λ] ](Subscript[Cas, j]))//(Subscript[km, i,j->i]))[[3]];

eqns2=Select[CoefficientRules[Coefficient[(∂_λ)Φ[λ]+((∂_λ)((1-T)((1/2)+(Subscript[a, i]))λ+((((E^(λ(1-T)))-1))/(1-T))(E^(-(1-T)λ))(Subscript[y, i])(Subscript[x, i])))Φ[λ]-(((Subscript[𝔼, {}->{i}])[(1-T)((1/2)+(Subscript[a, i]))λ,((((E^(λ(1-T)))-1))/(1-T))(E^(-(1-T)λ))(Subscript[y, i])(Subscript[x, i]),Φ[λ] ](Subscript[Cas, j]))//(Subscript[km, i,j->i]))[[3]],(ϵ^2)],{(Subscript[y, i]),(Subscript[a, i]),(Subscript[x, i])}],(#[[1,1]]+2#[[1,2]]+#[[1,1]])≤4*2&]/.(u_->v_):>(v==0)//.U2l//Simplify

Φ[λ]=Φ[λ]/.DSolve[Join[Table[(f/.λ->0)==0,{f,ϕs}],eqns2],ϕs,λ][[1]]

Φ[λ]=

Expw2=((Subscript[𝔼, {i}->{i}])[(1-T)((Subscript[a, i])+(1/2))(Subscript[ω, i]),((((E^((Subscript[ω, i])(1-T)))-1))/(1-T))(E^(-(1-T)(Subscript[ω, i])))(Subscript[y, i])(Subscript[x, i]),Φ[λ]]/.(Subscript[ω, i])->(t/(1-T))/.λ->(t/(1-T))//Simplify)//.l2U//Simplify

(Subscript[R, 1,2])

(Subscript[w2a, i_]):=(Subscript[𝔼, {i}->{i}])[(1-T)((Subscript[a, i])+(1/2))(Subscript[ω, i]),((((E^((Subscript[ω, i])(1-T)))-1))/(1-T))(E^(-(1-T)(Subscript[ω, i])))(Subscript[y, i])(Subscript[x, i])+(Subscript[ξ, i])(Subscript[x, i])+(Subscript[η, i])(Subscript[y, i]),(Φ[λ]/.λ:>(Subscript[ω, i]))+((O[ϵ])^3)]//.U2l

(Subscript[w2a, i_]):=(Subscript[𝔼, {i}->{i}])[(1-T)((Subscript[a, i])+(1/2))(Subscript[ω, i]),((((E^((Subscript[ω, i])(1-T)))-1))/(1-T))(E^(-(1-T)(Subscript[ω, i])))(Subscript[y, i])(Subscript[x, i])+(Subscript[ξ, i])(Subscript[x, i])+(Subscript[η, i])(Subscript[y, i]),(Φ[λ]/.KinkSol/.λ:>(Subscript[ω, i]))+((O[ϵ])^2)]//.U2l//Simplify

(Subscript[w2a, i])

(Subscript[FF, z_]):=If[z==0,1,Sum[(Subscript[f, u,v])[(Subscript[α, i])]((Subscript[y, i])^v)((Subscript[w, i])^(u-v))((Subscript[x, i])^v),{u,0,2z},{v,0,u}]]
F=(Subscript[FF, 0])+ϵ (Subscript[FF, 1])+((O[ϵ])^2)
(Subscript[fs, z_]):=Flatten@ Table[(Subscript[f, u,v])[(Subscript[α, i])],{u,0,2z},{v,0,u}]

(Subscript[a2w, i_]):=(Subscript[𝔼, {i}->{i}])[(Subscript[α, i])(((-1)/2)+((Subscript[w, i])/(1-T))),((E^(-(Subscript[α, i])))-1)(((Subscript[y, i])(Subscript[x, i]))/(1-T))+(Subscript[ξ, i])(Subscript[x, i])+(Subscript[η, i])(Subscript[y, i]),F+((O[ϵ])^2)]//.U2l

(*1+ϵ (-(((E^(-t-(Subscript[α, i]))) (-1+(E^(Subscript[α, i]))) (Subscript[x, i]) (Subscript[y, i]))/(((-1+(E^(-t))))^2))-((2 (E^(-t-(Subscript[α, i]))) (-1+(E^(Subscript[α, i]))) (Subscript[w, i]) (Subscript[x, i]) (Subscript[y, i]))/(((-1+(E^(-t))))^3))+(((E^(-2 (Subscript[α, i]))) (-1+3 (E^(-t))) (-1+(E^(2 (Subscript[α, i])))) (Subscript[x, i]^2) (Subscript[y, i]^2))/(4 (((-1+(E^(-t))))^3)))-(((1+(E^(-t))) (Subscript[α, i]))/(24 (-1+(E^(-t)))))+(((1+(E^(-t))) (Subscript[w, i]^2) (Subscript[α, i]))/(2 (((-1+(E^(-t))))^3))))*)

(((Subscript[a2w, i])//(Subscript[w2a, i]))//.U2l//CF//Simplify//Normal)/.ϵ->0
(((Subscript[w2a, i])//(Subscript[a2w, i]))//.U2l//CF//Simplify//Normal)/.ϵ->0

Sol1=FullSimplify/@(Solve[Thread[Flatten@CoefficientList[Coefficient[(((Subscript[a2w, i])//(Subscript[w2a, i]))//.U2l//Simplify)[[3]],ϵ], {(Subscript[x, i]),(Subscript[a, i]),(Subscript[y, i])}]==0],(Subscript[fs, 1])][[1]]/.((((E^(ww_))))^(w_))->(E^(ww w)))

Clear[F]
F=(Subscript[FF, 0])+ϵ ((Subscript[FF, 1])/.Sol1)+((O[ϵ])^2)

F=(Subscript[FF, 0])+ϵ ((Subscript[FF, 1])/.Sol1)+(ϵ^2)((Subscript[FF, 2]))+((O[ϵ])^3)
Sol2=Solve[Thread[Flatten@CoefficientList[Coefficient[(((Subscript[a2w, i])//(Subscript[w2a, i]))//.U2l//CF//Simplify)[[3]],(ϵ^2)], {(Subscript[x, i]),(Subscript[a, i]),(Subscript[y, i])}]==0],(Subscript[fs, 2])][[1]]

Clear[F]
F=(Subscript[FF, 0])+ϵ ((Subscript[FF, 1])/.Sol1)+(ϵ^2)((Subscript[FF, 2])/.Sol2)+((O[ϵ])^3)

F=(Subscript[FF, 0])+ϵ ((Subscript[FF, 1])/.Sol1)

((Subscript[a2w, i])//(Subscript[w2a, i]))//.U2l//CF//FullSimplify
((Subscript[w2a, i])//(Subscript[a2w, i]))//.U2l//CF//Simplify

Simplify[((E^((Subscript[α, i])/(-1+(E^t))))-((E^((((E^t) (Subscript[α, i]))/(-1+(E^t)))(E^(-t)))))) ,Assumptions->t>0]

F

((Subscript[kKink, i])//(Subscript[a2w, i])//Simplify)/.{(((((((1/T)))^(z_))))^(zz_))->((((1/T)))^(z zz))}//Simplify

TrigToExp/@((Subscript[a2w, i])//FullSimplify)//FullSimplify

(Subscript[w2a, i])

(Subscript[a2w, i])

(Subscript[w2a, i_]):=(Subscript[𝔼, {i}->{i}])[(1-(E^(-t))) ((1/2)+(Subscript[a, i])) (Subscript[ω, i]),(Subscript[y, i]) (Subscript[η, i])+(Subscript[x, i]) (-(((E^t) (-1+(E^((-1+(E^(-t))) (Subscript[ω, i])))) (Subscript[y, i]))/(-1+(E^t)))+(Subscript[ξ, i])),1+(1/(4 (((-1+(E^t)))^3) t))(E^(-t)) (4 (((-1+(E^t)))^4) (Subscript[a, i]^2) (Subscript[ω, i])+(E^(2 t)) (Subscript[x, i]^2) (Subscript[y, i]^2) ((E^t) (-1+(E^((-1+(E^(-t))) (Subscript[ω, i])))) (-3+(E^t)+5 (E^((-1+(E^(-t))) (Subscript[ω, i])))+(E^(t+(-1+(E^(-t))) (Subscript[ω, i])))) t+4 (E^(2 (-1+(E^(-t))) (Subscript[ω, i]))) (((-1+(E^t)))^2) (Subscript[ω, i]))+4 (-1+(E^t)) (Subscript[a, i]) ((((-1+(E^t)))^3) (Subscript[ω, i])+2 (E^(t-(Subscript[ω, i]))) (Subscript[x, i]) (Subscript[y, i]) ((E^t) (-(E^(Subscript[ω, i]))+(E^((E^(-t)) (Subscript[ω, i])))) t+(E^((E^(-t)) (Subscript[ω, i]))) (((-1+(E^t)))^2) (Subscript[ω, i])))) ϵ+((O[ϵ])^2)]

(Subscript[a2w, i_]):=(Subscript[𝔼, {i}->{i}])[(-(1/2)+((Subscript[w, i])/(1-(E^(-t))))) (Subscript[α, i]),(((-1+(E^(-(Subscript[α, i])))) (Subscript[x, i]) (Subscript[y, i]))/(1-(E^(-t))))+(Subscript[y, i]) (Subscript[η, i])+(Subscript[x, i]) (Subscript[ξ, i]),1+((((E^t) (-1+(E^(-(Subscript[α, i])))) (Subscript[x, i]) (Subscript[y, i]))/(((-1+(E^t)))^2))+((2 (E^(2 t)) (1-(E^(-(Subscript[α, i])))) (Subscript[w, i]) (Subscript[x, i]) (Subscript[y, i]))/(((-1+(E^t)))^3))-(((E^(2 t)) (-3+(E^t)) (-1+(E^(-2 (Subscript[α, i])))) (Subscript[x, i]^2) (Subscript[y, i]^2))/(4 (((-1+(E^t)))^3)))+((Subscript[α, i])/(4 t))-(((E^(2 t)) (Subscript[w, i]^2) (Subscript[α, i]))/((((-1+(E^t)))^2) t))) ϵ+((O[ϵ])^2)]

Z@Knot[3,1]//(Subscript[a2w, 0])

wTensors

Define[(Subscript[wR, i,j])=((Subscript[tR, i,j])//((Subscript[a2w, i])(Subscript[a2w, j])))//.l2U//CF,
(Subscript[(OverBar[wR]), i,j])=((Subscript[(OverBar[tR]), i,j])//((Subscript[a2w, i])(Subscript[a2w, j])))//.l2U//CF ,
(Subscript[wm, i,j->k])=(((Subscript[w2a, i])(Subscript[w2a, j]))//(Subscript[tm, i,j->k])//(Subscript[a2w, k]) )//.l2U//CF,
(Subscript[wC, i])=((Subscript[tC, i])//(Subscript[a2w, i]))//.l2U//CF ,
(Subscript[(OverBar[wC]), i])=((Subscript[(OverBar[tC]), i])//(Subscript[a2w, i]))//.l2U//CF,
(Subscript[wKink, i])=((Subscript[tKink, i])//(Subscript[a2w, i]))//.l2U//CF ,
(Subscript[(OverBar[wKink]), i])=((Subscript[(OverBar[tKink]), i])//(Subscript[a2w, i]))//.l2U//CF,
(Subscript[wΔ, i->j,k])=(Subscript[w2a, i])//(Subscript[tΔ, i->j,k])//((Subscript[a2w, j])(Subscript[a2w, k]))//.l2U//CF,
(Subscript[wS, i])=(Subscript[w2a, i])//(Subscript[tS, i])//(Subscript[a2w, i]) //.l2U//CF]

Define[(Subscript[wkR, i,j])=(Subscript[kR, i,j])//((Subscript[a2w, i])(Subscript[a2w, j]))//.l2U//CF,
(Subscript[(OverBar[wkR]), i,j])=((Subscript[(OverBar[kR]), i,j])//((Subscript[a2w, i])(Subscript[a2w, j])))//.l2U//CF ,
(Subscript[wkm, i,j->k])=(((Subscript[w2a, i])(Subscript[w2a, j]))//((Subscript[km, i,j->k])//.l2U)//(Subscript[a2w, k]) )//.l2U//CF,
(Subscript[wkC, i])=((Subscript[kC, i])//(Subscript[a2w, i]))//.l2U//CF ,
(Subscript[(OverBar[wkC]), i])=((Subscript[(OverBar[kC]), i])//(Subscript[a2w, i]))//.l2U//CF,
(Subscript[wkKink, i])=((Subscript[kKink, i])//(Subscript[a2w, i]))//.l2U//CF ,
(Subscript[(OverBar[wkKink]), i])=((Subscript[(OverBar[kKink]), i])//(Subscript[a2w, i]))//.l2U//CF,
(Subscript[uwkR, i,j])=((Subscript[𝔼, {}->{i,j1}])[0,0,(1/(Sqrt[T]))](Subscript[wkR, i,j1]))(Subscript[(OverBar[wkKink]), j2])//(Subscript[wkm, j1,j2->j]),
(Subscript[(OverBar[uwkR]), i,j])=(Subscript[𝔼, {}->{i,j1}])[0,0,Sqrt[T]](Subscript[(OverBar[wkR]), i,j1])(Subscript[wkKink, j2])//(Subscript[wkm, j1,j2->j])
]

Simplify/@((Subscript[𝔼, {}->{i}])[0,0,(Subscript[w, i])]//(Subscript[w2a, i])//CF)

Simplify/@((Subscript[𝔼, {}->{i}])[0,0,(Subscript[a, i])]//(Subscript[a2w, i])//CF)

((Subscript[wkKink, 8])//.U2l//FullSimplify)//.l2U
((Subscript[(OverBar[wkKink]), 8])//.U2l//FullSimplify)//.l2U

(Subscript[wkm, 1,2->3])

(Subscript[wkm, 1,2->3])/.ϵ->0

(Subscript[wkm, 1,2->3])/.{(Subscript[ω, _])->0,(Subscript[Ω, _])->1}

(Subscript[km, 1,2->3])

(Subscript[wkR, 5,1])
(Subscript[(OverBar[wkR]), 5,1])

(Subscript[wkR, 5,1])(Subscript[wkR, 2,6])(Subscript[wkR, 7,3])(Subscript[wkC, 4])//(Subscript[wkm, 1,2->1])//(Subscript[wkm, 1,3->1])//(Subscript[wkm, 1,4->1])//(Subscript[wkm, 1,5->1])//(Subscript[wkm, 1,6->1])//(Subscript[wkm, 1,7->1])

(Subscript[wkR, 5,1])

(Subscript[(OverBar[wkKink]), 8])(Subscript[(OverBar[wkKink]), 9])(Subscript[(OverBar[wkKink]), 10]) (Subscript[wkR, 5,1])(Subscript[wkR, 2,6])(Subscript[wkR, 7,3])(Subscript[wkC, 4])//(Subscript[wkm, 1,2->1])//(Subscript[wkm, 1,3->1])//(Subscript[wkm, 1,4->1])//(Subscript[wkm, 1,5->1])//(Subscript[wkm, 1,6->1])//(Subscript[wkm, 1,7->1])//(Subscript[wkm, 1,8->1])//(Subscript[wkm, 1,9->1])//(Subscript[wkm, 1,10->1])//Timing

(Subscript[(OverBar[kKink]), 8])(Subscript[(OverBar[kKink]), 9])(Subscript[(OverBar[kKink]), 10]) (Subscript[kR, 5,1])(Subscript[kR, 2,6])(Subscript[kR, 7,3])(Subscript[kC, 4])//(Subscript[km, 1,2->1])//(Subscript[km, 1,3->1])//(Subscript[km, 1,4->1])//(Subscript[km, 1,5->1])//(Subscript[km, 1,6->1])//(Subscript[km, 1,7->1])//(Subscript[km, 1,8->1])//(Subscript[km, 1,9->1])//(Subscript[km, 1,10->1])
% //(Subscript[a2w, 1])

RVK[pd_PD]:=Module[{n,xs,x,rots,front={0},k},
n=Length@pd;rots=Table[0,{2n}];
xs=Cases[pd,x_X:>(Piecewise[{{Xp[x[[4]],x[[1]]], PositiveQ@x}, {Xm[x[[2]],x[[1]]], True}}])];
For[k=0,k<2n,++k,If[k==0∨FreeQ[front,-k],
front=Flatten[front/.k->(xs/.{
Xp[k+1,l_]|Xm[l_,k+1]:>{l,k+1,1-l},
Xp[l_,k+1]|Xm[k+1,l_]:>(++rots[[l]];{1-l,k+1,l})
})],
Cases[front,k|-k]/.{k,-k}:>--rots[[k+1]];
]];
RVK[xs,rots] ];
RVK[K_]:=RVK[PD[K]];

rot[i_,0]:=(Subscript[𝔼, {}->{i}])[0,0,1];
rot[i_,n_]:=Module[{j},
rot[i,n]=If[n>0,rot[i,n-1](Subscript[kC, j]),rot[i,n+1](Subscript[(OverBar[kC]), j])]//(Subscript[km, i,j->i])];

Z[K_] := Z[RVK@K];
Z[rvk_RVK] := (*Z[rvk] =*)Module[{todo,n,rots,ζ,done,st,cx, ζ1, i,j,k,k1,k2,k3},
{todo,rots}=List@@rvk;
AppendTo[rots,0];
n=Length[todo];
ζ=(Subscript[𝔼, {}->{0}])[0,0,1];
done={0};
st=Range[0,2n+1];
While[{}=!=($M=todo),
{cx}=MaximalBy[todo, Length[done⋂{#[[1]], #[[2]], #[[1]]-1,#[[2]]-1}]&,1];
{i,j}=List@@cx;
ζ1=Switch[Head[cx],
 Xp, ((Subscript[kR, i,j])(Subscript[(OverBar[kKink]), k]))//(Subscript[km, j,k->j]),
 Xm, ((Subscript[(OverBar[kR]), i,j])(Subscript[kKink, k]))//(Subscript[km, j,k->j])
];
ζ1=(rot[k,rots[[i]]]ζ1)//(Subscript[km, k,i->i]); rots[[i]]=0;
ζ1=(ζ1 rot[k, rots[[i+1]]])//(Subscript[km, i,k->i]); rots[[i+1]]=0;
ζ1=(rot[k,rots[[j]]]ζ1)//(Subscript[km, k,j->j]); rots[[j]]=0;
ζ1=(ζ1 rot[k, rots[[j+1]]])//(Subscript[km, j,k->j]); rots[[j+1]]=0;
ζ*=ζ1;
If[MemberQ[done, i], ζ=ζ//(Subscript[km, i,i+1->i]); st=st/.st[[i+2]]->st[[i+1]]];
If[MemberQ[done, i-1],  ζ=ζ//(Subscript[km, st[[i]],i->st[[i]]]); st=st/.st[[i+1]]->st[[i]]]; 
If[MemberQ[done, j],  ζ=ζ//(Subscript[km, j,j+1->j]); st=st/.st[[j+2]]->st[[j+1]]]; 
If[MemberQ[done, j-1],  ζ=ζ//(Subscript[km, st[[j]],j->st[[j]]]); st=st/.st[[j+1]]->st[[j]]];
done=done⋃{i-1,i,j-1,j};
todo=DeleteCases[todo, cx]
];
CF/@ (ζ (*/. {(Subscript[x, 0])->x,(Subscript[y, 0])->y,(Subscript[a, 0])->a}*))
]

Z31=Z@Knot[3,1]//Timing

Z31[[2]]//(Subscript[a2w, 0])
Collect[%[[3]],{ϵ,(Subscript[w, 0])},Factor]

Z41=Z@Knot[4,1]
Z41//(Subscript[a2w, 0])
Collect[%[[3]],{ϵ,(Subscript[w, 0])},Factor]

Z51=Z@Knot[5,1]
Z51//(Subscript[a2w, 0])
Collect[%[[3]],{ϵ,(Subscript[w, 0])},Factor]

Z52=Z@Knot[5,2];
Z52//(Subscript[a2w, 0])
Collect[%[[3]],{ϵ,(Subscript[w, 0])},Factor]

Z61=Z@Knot[6,1]
Z61//(Subscript[a2w, 0])
Collect[%[[3]],{ϵ,(Subscript[w, 0])},Factor]

Z63=Z@Knot[6,3]
Z63//(Subscript[a2w, 0])
Collect[%[[3]],{ϵ,(Subscript[w, 0])},Factor]

((T-4 (T^2)-12 (T^3)+22 (T^4)-12 (T^5)-4 (T^6)+(T^7))/(12-144 T+696 (T^2)-1728 (T^3)+2340 (T^4)-1728 (T^5)+696 (T^6)-144 (T^7)+12 (T^8)))//Factor

(5+(1/(t^4))-(4/(t^2))-4 (t^2)+(t^4))/.t->(T^(1/2))//Factor

1-(1/(t^4))+(1/(t^2))+(t^2)-(t^4)/.t->(T^(1/2))//Factor

-T+2 (T^2)-2 (T^3)+2 (T^4)-(T^5)//Factor

(((-2 (T^2)+4 (T^3)-5 (T^4)+6 (T^5)-6 (T^6)+6 (T^7)-5 (T^8)+4 (T^9)-2 (T^10)))/(-(((-1+T))^2) T))//Factor//Expand

(22 (T^2)-93 (T^3)+205 (T^4)-355 (T^5)+505 (T^6)-721 (T^7)+1024 (T^8)-1330 (T^9)+1510 (T^10)-1330 (T^11)+1024 (T^12)-721 (T^13)+505 (T^14)-355 (T^15)+205 (T^16)-93 (T^17)+22 (T^18))//Factor

Knots=Z/@AllKnots[{3,5}]

Factor[12(((Normal@#[[3]]/.{w->0,ϵ->0}))^(-5))Coefficient[#[[3]]/.w->0,(ϵ^2)]]&/@Knots

-2 (T^2)+4 (T^3)-5 (T^4)+6 (T^5)-6 (T^6)+6 (T^7)-5 (T^8)+4 (T^9)-2 (T^10)//Factor

Analyse[EE_]:=CoefficientList[Coefficient[EE[[3]],ϵ],w]//Factor

Knots =Analyse/@Z/@AllKnots[{3,7}]

Knots//MatrixForm

Alexes[KK_]:=D[(Alexander@KK)@T,T]//Factor

Alex[KK_]:=((Alexander@KK)@T)^2

Alexes/@AllKnots[{3,7}]

{(Alex/@AllKnots[{3,7}])Knots[[;;,2]]/Alexes/@AllKnots[{3,7}]//Factor}//MatrixForm

The most basic tensors

(Subscript[wkm, i,j->k])

((Subscript[wkm, 1,2->1])//(Subscript[wkm, 1,3->1]))≡((Subscript[wkm, 2,3->2])//(Subscript[wkm, 1,2->1]))

(Subscript[wkR, i,j])

((Subscript[wkR, 1,2])(Subscript[wkR, 4,3])(Subscript[wkR, 5,6])//(Subscript[wkm, 1,4->1])(Subscript[wkm, 2,5->2])(Subscript[wkm, 3,6->3]))≡((Subscript[wkR, 2,3])(Subscript[wkR, 1,6])(Subscript[wkR, 4,5])//(Subscript[wkm, 1,4->1])(Subscript[wkm, 2,5->2])(Subscript[wkm, 3,6->3]))

Even basicer tensors

(Subscript[bbm, i_,j_->k_]):=(Subscript[𝔼, {i,j}->{k}])[0,(Subscript[y, k]) (Subscript[η, i])+(Subscript[y, k]) (Subscript[η, j])+(Subscript[x, k]) (Subscript[ξ, i])+(1-T) (Subscript[η, j]) (Subscript[ξ, i])+(Subscript[x, k]) (Subscript[ξ, j]),1+ϵ (-T (Subscript[η, j]) (Subscript[ξ, i])+(((-1+3 T) (Subscript[x, k]) (Subscript[y, k]) (Subscript[η, j]) (Subscript[ξ, i]))/(-1+T))+(1/2) (1-3 T) (Subscript[y, k]) (Subscript[η, j]^2) (Subscript[ξ, i])+(1/2) (1-3 T) (Subscript[x, k]) (Subscript[η, j]) (Subscript[ξ, i]^2)+(1/4) (1-4 T+3 (T^2)) (Subscript[η, j]^2) (Subscript[ξ, i]^2))+((O[ϵ])^2)]

((Subscript[bbm, 1,2->1])//(Subscript[bbm, 1,3->1]))≡((Subscript[bbm, 2,3->2])//(Subscript[bbm, 1,2->1]))

(Subscript[bbR, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[0,(Subscript[x, j]) (Subscript[y, i])-(Subscript[x, j]) (Subscript[y, j]),1+ϵ ((1/2)-(((Subscript[x, i]) (Subscript[y, i]))/(-2+2 T))-(1/4) (Subscript[x, j]^2) (Subscript[y, i]^2)+((T (Subscript[x, j]) (Subscript[y, j]))/(-2+2 T))+((T (Subscript[x, i]) (Subscript[x, j]) (Subscript[y, i]) (Subscript[y, j]))/(1-2 T+(T^2)))+(((1-2 T-3 (T^2)) (Subscript[x, j]^2) (Subscript[y, j]^2))/(4-8 T+4 (T^2))))+((O[ϵ])^2)]

((Subscript[bbR, 1,2])(Subscript[bbR, 4,3])(Subscript[bbR, 5,6])//(Subscript[bbm, 1,4->1])(Subscript[bbm, 2,5->2])(Subscript[bbm, 3,6->3]))≡((Subscript[bbR, 2,3])(Subscript[bbR, 1,6])(Subscript[bbR, 4,5])//(Subscript[bbm, 1,4->1])(Subscript[bbm, 2,5->2])(Subscript[bbm, 3,6->3]))

Even basicer tensors

(Subscript[bbm, i_,j_->k_]):=(Subscript[𝔼, {i,j}->{k}])[0,(Subscript[y, k]) (Subscript[η, i])+(Subscript[y, k]) (Subscript[η, j])+(Subscript[x, k]) (Subscript[ξ, i])+(1-T) (Subscript[η, j]) (Subscript[ξ, i])+(Subscript[x, k]) (Subscript[ξ, j]),1+ϵ (-T (Subscript[η, j]) (Subscript[ξ, i])+(((-1+3 T) (Subscript[x, k]) (Subscript[y, k]) (Subscript[η, j]) (Subscript[ξ, i]))/(-1+T))+(1/2) (1-3 T) (Subscript[y, k]) (Subscript[η, j]^2) (Subscript[ξ, i])+(1/2) (1-3 T) (Subscript[x, k]) (Subscript[η, j]) (Subscript[ξ, i]^2)+(1/4) (1-4 T+3 (T^2)) (Subscript[η, j]^2) (Subscript[ξ, i]^2))+((O[ϵ])^2)]

((Subscript[bbm, 1,2->1])//(Subscript[bbm, 1,3->1]))≡((Subscript[bbm, 2,3->2])//(Subscript[bbm, 1,2->1]))

(Subscript[bbR, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[0,(Subscript[x, j]) (Subscript[y, i])-(Subscript[x, j]) (Subscript[y, j]),1+ϵ ((1/2)-(((Subscript[x, i]) (Subscript[y, i]))/(-2+2 T))-(1/4) (Subscript[x, j]^2) (Subscript[y, i]^2)+((T (Subscript[x, j]) (Subscript[y, j]))/(-2+2 T))+((T (Subscript[x, i]) (Subscript[x, j]) (Subscript[y, i]) (Subscript[y, j]))/(1-2 T+(T^2)))+(((1-2 T-3 (T^2)) (Subscript[x, j]^2) (Subscript[y, j]^2))/(4-8 T+4 (T^2))))+((O[ϵ])^2)]

((Subscript[bbR, 1,2])(Subscript[bbR, 4,3])(Subscript[bbR, 5,6])//(Subscript[bbm, 1,4->1])(Subscript[bbm, 2,5->2])(Subscript[bbm, 3,6->3]))≡((Subscript[bbR, 2,3])(Subscript[bbR, 1,6])(Subscript[bbR, 4,5])//(Subscript[bbm, 1,4->1])(Subscript[bbm, 2,5->2])(Subscript[bbm, 3,6->3]))