Pensieve header: Proof of invariance of $\rho_2$ using integration techniques.

Initialization

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

Initialization

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[ℰ];
CCF[ℰ_] := Factor[ℰ];
CF[ω_.ℰ_𝔼]:=CF[ω]CF/@ℰ;
CF[ℰ_List]:=CF/@ℰ;
CF[ℰ_] := Module[{vs=Cases[ℰ,(Subscript[(x|p|π), __]),∞]⋃{x,p,ϵ},ps,c},
Total[CoefficientRules[Expand[ℰ], vs] /. (ps_->c_) :> CCF[c](Times@@(vs^ps))] ];

The Basic Feynman Ring

𝒮={x,(Subscript[x, _]),y,z};
(Subscript[q, x_,y_])[f_]:=((∂_(x,y))f)/.Thread[𝒮->0];
(Subscript[θ, x_,y_]):=x y;
f_≡0:=f===0;
(Subscript[Ev, vs_List->0])[f_]:=CF[f/.Thread[vs->0]]

The ϵSeries Feynman Ring

𝒮={x,y,z,ϕ,(Subscript[x, _]),(Subscript[p, _]),(Subscript[(UnderBar[x]), _]),(Subscript[(UnderBar[p]), _])};(Subscript[q, x_,y_])[ser_ϵSeries]:=((∂_(x,y))ser[[1]])/.Thread[𝒮->0];
(Subscript[θ, x_,y_]):=x y;
ϵSeries/:D[ser_ϵSeries,vs___]:=D[#,vs]&/@ser;
ϵSeries/:Plus[ss___ϵSeries]/;Length[{ss}]>1:=Module[{l=Min[Length/@{ss}]},
ϵSeries@@Total[Take[List@@#,l]&/@{ss}]]
ϵSeries/:t_+ser_ϵSeries:=MapAt[(#+t)&,ser,1];
ϵSeries/:s1_ϵSeries*s2_ϵSeries:=ϵSeries@@Table[Sum[s1[[ii+1]]s2[[kk-ii+1]],{ii,0,kk}],{kk,0,Min[Length@s1,Length@s2]-1}];
ϵSeries/:c_*ser_ϵSeries:=(c#)&/@ser;
ser_ϵSeries ≡ 0 := And@@((#===0)&/@ser);
ϵSeries/:Integrate[ser_ϵSeries,pars__]:=ϵSeries@@(Integrate[#,pars]&/@ser);
ϵSeries/:(Subscript[Ev, vs_List->0])[ser_ϵSeries]:=ser/.Thread[vs->0];
CF[ser_ϵSeries]:=CF/@ser;

Integration

Using Picard Iteration!

𝔼/:𝔼[A_]𝔼[B_]:=𝔼[A+B]

𝔼[sd_SeriesData]/;(List@@sd)[[{1,2,4,6}]]==={ϵ,0,0,1}:=𝔼[ϵSeries@@PadRight[sd[[3]],sd[[5]],0]]

Following a program in Projects/FullDoPeGDO/Engine.nb, we write (Subscript[Z, λ])=∑Z[m](λ^m).

Unprotect[Integrate];
Integrate::sing="How dare you ask me to integrate a singular Gaussian!";
∫ω_.𝔼[L_]\[DifferentialD](vs_List):=Module[{n,Q,Δ,G,a,b,m,m1,$m},Clear[Z];
n=Length@vs;
Q=Table[(Subscript[q, vs[[a]],vs[[b]]])[L],{a,n},{b,n}];
If[(Δ=CF@Det[-Q])==0,Message[Integrate::sing]; Return[]];
G=CF[-Inverse[Q]/2];Z[]=Z[0]=CF[L-Sum[Q[[a,b]](Subscript[θ, vs[[a]],vs[[b]]]),{a,n},{b,n}]/2];
Z[m_,a_]:=Z[m,a]=CF@D[Z[m],vs[[a]]];
Z[m_,a_,b_]/;a<=b:=Z[m,a,b]=CF@D[Z[m,a],vs[[b]]];
Z[m_,a_,b_]/;a>b:=Z[m,b,a];
For[$m=m=0,m≤2$m,++m,
Z[m+1]=CF@Sum[Sum[If[G[[a,b]]===0,0,
((G[[a,b]])/(m+1))(Z[m,a,b]+Sum[Z[m1,a]Z[m-m1,b],{m1,0,m}])],
{a,n}],{b,n}];
If[!(Z[m+1]≡0),$m=m+1;Z[]+=Z[m+1]];
];
PowerExpand@Factor[ω (Δ^(-1/2))]𝔼[CF[(Subscript[Ev, vs->0])[Z[]]]]
];
Protect[Integrate];

∫𝔼[- μ (x^2)/2+I ξ x]\[DifferentialD]{x}

L=-(1/2){(Subscript[x, 1]),(Subscript[x, 2])}.(({{a, b}, {b, c}})).{(Subscript[x, 1]),(Subscript[x, 2])}+{(Subscript[ξ, 1]),(Subscript[ξ, 2])}.{(Subscript[x, 1]),(Subscript[x, 2])};
Z12=∫𝔼[L]\[DifferentialD]{(Subscript[x, 1]),(Subscript[x, 2])}

{Z1=∫𝔼[L]\[DifferentialD]{(Subscript[x, 1])}, Z12==∫Z1 \[DifferentialD]{(Subscript[x, 2])}}

Integration of ϵSeries

∫𝔼[-(x^2)/2+ϵ (x^3)/6+((O[ϵ])^13)]\[DifferentialD]{x}

The (Subscript[ρ, 2]) Integrand

Adopted from pensieve://Talks//Oaxaca-2210/Rho.nb.

𝒮={(Subscript[x, _]),(Subscript[p, _])};
q[s_,i_,j_]:=(Subscript[x, i]) ((Subscript[p, i+1])-(Subscript[p, i]))+(Subscript[x, j]) ((Subscript[p, j+1])-(Subscript[p, j]))+((T^s)-1)(Subscript[x, i])((Subscript[p, i+1])-(Subscript[p, j+1]));
(Subscript[r, 1])[s_,i_,j_]:=(s/2)((Subscript[x, i])((Subscript[p, i])-(Subscript[p, j]))(((T^s)-1)(Subscript[x, i])(Subscript[p, j])+2(1-(Subscript[p, j])(Subscript[x, j])))-1);
(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;
(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));
(Subscript[γ, 1])[φ_,k_]:=φ(1/2-(Subscript[x, k])(Subscript[p, k]));
(Subscript[γ, 2])[φ_,k_]:=-(φ^2)(Subscript[p, k])(Subscript[x, k])/2;
ℒ[(Subscript[X, i_,j_])[s_]]:=(T^(s/2))𝔼[q[s,i,j]+ϵ (Subscript[r, 1])[s,i,j]+(ϵ^2)(Subscript[r, 2])[s,i,j]+((O[ϵ])^3)];
ℒ[(Subscript[C, k_])[φ_]]:=(T^(φ/2))𝔼[-(Subscript[x, k])((Subscript[p, k])-(Subscript[p, k+1]))+ϵ (Subscript[γ, 1])[φ,k]+(ϵ^2)(Subscript[γ, 2])[φ,k]+((O[ϵ])^3)];
ℒ[K_]:=(((2π))^(-Features[K][[1]]))CF[ℒ/@Features[K][[2]]];
vs[K_] := Union@@Table[{(Subscript[p, i]),(Subscript[x, i])},{i,Features[K][[1]]}]

(ϵ^2)(Subscript[r, 2])[1,i,j]

(ϵ^2)(Subscript[r, 2])[-1,i,j]

(ϵ^2)(Subscript[γ, 2])[φ,i]

Features[Knot[3,1]]

ℒ[Knot[3,1]]

vs[Knot[3,1]]

K=Knot[3,1]; ∫ℒ[K]\[DifferentialD](vs@K)

Invariance Under Reidemeister 3

lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,k])[1](Subscript[X, j+1,k+1])[1]))\[DifferentialD]{(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1]),(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1])}
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ℒ/@((Subscript[X, j,k])[1](Subscript[X, i,k+1])[1](Subscript[X, i+1,j+1])[1]))\[DifferentialD]{(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1]),(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1])};
lhs==rhs

Invariance Under Reidemeister 2b

Territory: (Subscript[(x|p), (SuperPlus[(i|j)])]), (Subscript[x, i|j]).

lhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,j+1])[-1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1])}
rhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, j])[0](Subscript[C, j+1])[0])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1])};
lhs==rhs

Invariance Under R2c

lhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ/@((Subscript[X, i+1,j])[1](Subscript[X, i,j+2])[-1](Subscript[C, j+1])[1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, j+2]),(Subscript[p, j+2])}
rhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, j])[0](Subscript[C, j+1])[1](Subscript[C, j+2])[0])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, j+2]),(Subscript[p, j+2])};
lhs==rhs

Invariance Under R1l

lhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ/@((Subscript[X, i+2,i])[1](Subscript[C, i+1])[1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1]),(Subscript[x, i+2]),(Subscript[p, i+2])}
rhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, i+2])[0])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1]),(Subscript[x, i+2]),(Subscript[p, i+2])};
lhs==rhs

Invariance Under R1r

lhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ/@((Subscript[X, i,i+2])[1](Subscript[C, i+1])[-1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1]),(Subscript[x, i+2]),(Subscript[p, i+2])}
rhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, i+2])[0])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1]),(Subscript[x, i+2]),(Subscript[p, i+2])};
lhs==rhs

Invariance Under Sw

lhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ/@((Subscript[X, i+1,j+1])[1](Subscript[C, i])[-1](Subscript[C, j])[-1](Subscript[C, i+2])[1](Subscript[C, j+2])[1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, i+2]),(Subscript[p, i+2]),(Subscript[x, j+2]),(Subscript[p, j+2])}
rhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ/@((Subscript[X, i+1,j+1])[1](Subscript[C, i])[0](Subscript[C, j])[0](Subscript[C, i+2])[0](Subscript[C, j+2])[0])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[x, i+2]),(Subscript[p, i+2]),(Subscript[x, j+2]),(Subscript[p, j+2])};
lhs==rhs