Pensieve header: Invariance of  $\rho_1$ in the language of perturbed Gaussian Integration.

Programs

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

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[ℰ];
CCF[ℰ_] := Factor[ℰ];
CF[ℰ_List]:=CF/@ℰ; CF[ℰ_EPD]:=CF/@ℰ;
CF[sd_SeriesData] := MapAt[CF,sd,3];
CF[ℰ_] := Module[{vs=Cases[ℰ,(Subscript[(x|p), _]),∞]⋃{x,p},ps,c},
Total[CoefficientRules[Expand[ℰ], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))] ];
CF[eqp_EQP]:=CF/@eqp

EQP/:c_*EQP[Q_,P_]:=EQP[Q,CF[c P]];
EQP/:EQP[Q1_,P1_]EQP[Q2_,P2_]:=CF@EQP[Q1+Q2,P1+P2];

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

FI[EQP[Q_,P_]]:=FI[EQP[Q,P],Union@Cases[Q,(Subscript[p, _]),∞],Union@Cases[Q,(Subscript[x, _]),∞]];
FI[EQP[Q_,P_],ps_List,xs_List]:=Module[{u,v},
A=Table[(∂_(u,v))Q,{u,ps},{v,xs}];
CF[((Det[A])^(-1))Series[(Subscript[Zip, ps⋃xs])[Normal[(E^P)](E^(-(SuperStar[xs]).Inverse[A].(SuperStar[ps])))], {ϵ,0,1}]
]]

(SuperPlus[((SuperPlus[α_]))]):=(α^("++"));    (* this is for cosmetic reasons only *)

(Subscript[R, 0])[s_,i_,j_]:=EQP[-(Subscript[x, i]) ((Subscript[p, i])-(T^s) (Subscript[p, (SuperPlus[i])])+((T^s)-1) (Subscript[p, (SuperPlus[j])]))-(Subscript[x, j]) ((Subscript[p, j])-(Subscript[p, (SuperPlus[j])])),0];
(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;
(Subscript[γ, 1])[φ_,k_]:=φ (1/2-(Subscript[p, k])(Subscript[x, k]));
(Subscript[R, 1])[s_,i_,j_]:=EQP[-(Subscript[x, i]) ((Subscript[p, i])-(T^s) (Subscript[p, (SuperPlus[i])])+((T^s)-1) (Subscript[p, (SuperPlus[j])]))-(Subscript[x, j]) ((Subscript[p, j])-(Subscript[p, (SuperPlus[j])])), ϵ (Subscript[r, 1])[s,i,j]+((O[ϵ])^2)];

eqp1[K_]:=Module[{Cs,φ,n,eqp,s,i,j,k,α},
{Cs,φ}=Rot[K]; n=Length[Cs];
eqp=EQP[-(Subscript[x, 2n+1])(Subscript[p, 2n+1]),((O[ϵ])^2)];
Cases[Cs,{s_,i_,j_}:>(eqp*=(Subscript[R, 1])[s,i,j])];
Do[eqp*=EQP[0,ϵ (Subscript[γ, 1])[φ[[k]],k]],{k,2n}];
CF[eqp/.(SuperPlus[(α_)]):>α+1] ];

eqp1[Knot[3,1]]

eqp1[Knot[5,2]]//FI

lhs=(Subscript[R, 0])[1,j,k](Subscript[R, 0])[1,i,(SuperPlus[k])](Subscript[R, 0])[1,(SuperPlus[i]),(SuperPlus[j])]

rhs=(Subscript[R, 0])[1,i,j](Subscript[R, 0])[1,(SuperPlus[i]),k](Subscript[R, 0])[1,(SuperPlus[j]),(SuperPlus[k])]