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

Initialization

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

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

The (Subscript[ρ, 2]) Integrand

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

Variable convention:

𝒮={(Subscript[x, _]),(Subscript[p, _]),(Subscript[(UnderBar[x]), _]),(Subscript[(UnderBar[p]), _])};
q[s_,i_,j_]:=(Subscript[x, i]) ((Subscript[p, i])-(Subscript[(UnderBar[p]), i+1]))+(Subscript[x, j]) ((Subscript[p, j])-(Subscript[(UnderBar[p]), j+1]))+(Subscript[x, i])((1-(T^s))(Subscript[(UnderBar[p]), i+1])+((T^s)-1)(Subscript[(UnderBar[p]), j+1]));
(Subscript[r, 1])[s_,i_,j_]:=s(-1+2(Subscript[p, i])(Subscript[x, i])-2(Subscript[p, j])(Subscript[x, i])+((T^s)-1)(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[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[(UnderBar[x]), k])(Subscript[(UnderBar[p]), k]));
(Subscript[γ, 2])[φ_,k_]:=-(φ^2)(Subscript[(UnderBar[p]), k])(Subscript[(UnderBar[x]), k])/2;
ℒ[s_,i_,j_]:=(T^(s/2))𝔼[-q[s,i,j]+ϵ (Subscript[r, 1])[s,i,j]+(ϵ^2)(Subscript[r, 2])[s,i,j]+((O[ϵ])^3)];
ℒ[φ_,k_]:=(T^(φ/2))𝔼[-(Subscript[(UnderBar[x]), k])((Subscript[(UnderBar[p]), k])-(Subscript[p, k]))+ϵ (Subscript[γ, 1])[φ,k]+(ϵ^2)(Subscript[γ, 2])[φ,k]+((O[ϵ])^3)];
ℒ[Dot,i_]:=𝔼[-(Subscript[x, i]) ((Subscript[p, i])-(Subscript[(UnderBar[p]), i+1]))+((O[ϵ])^3)];
ℒ[End,k_]:=𝔼[-(Subscript[(UnderBar[x]), k]) ((Subscript[(UnderBar[p]), k])-(Subscript[p, k]))-(Subscript[x, k])(Subscript[p, k])+((O[ϵ])^3)];
ℒ[K_]:=Module[{Cs,φ,n,c,k,ℰ},
{Cs,φ}=Rot[K]; n=Length[Cs];
ℰ=(((2π))^(4n+2))ℒ[End,2n+1];
Do[ℰ*=ℒ@@c,{c,Cs}];
Do[ℰ*=ℒ[φ[[k]],k],{k,2n}];
CF@ℰ
];
(Subscript[vs, i_]):=Sequence[(Subscript[(UnderBar[x]), i]),(Subscript[(UnderBar[p]), i]),(Subscript[x, i]),(Subscript[p, i])]
ρ2vs[K_] := Union@@Table[{(Subscript[vs, i])},{i,2Crossings[K]+1}]

ℒ[Knot[3,1]]

ρ2vs[Knot[3,1]]

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

T2z[(T^(-2)) (1-4 (T^2)+(T^4))]

Factor@(2-4 (z^2)+3 (z^4)+4 (z^6)+(z^8))

K=Knot[5,2]; ∫ℒ[K]\[DifferentialD](ρ2vs@K)

T2z[(1-4 T+11 (T^2)-44 (T^3)+76 (T^4)-44 (T^5)+11 (T^6)-4 (T^7)+(T^8))/(T^4)]

K=Knot[8,19]; ∫ℒ[K]\[DifferentialD](ρ2vs@K)

Concatenating edges

lhs=8 (π^3)∫(𝔼[(Subscript[(UnderBar[π]), i])(Subscript[(UnderBar[p]), i])]ℒ[φ1,i]ℒ[Dot,i]ℒ[φ2,i+1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[(UnderBar[x]), i+1]),(Subscript[(UnderBar[p]), i+1])}
rhs=(2 π∫𝔼[(Subscript[(UnderBar[π]), i])(Subscript[(UnderBar[p]), i])]ℒ[φ1+φ2,i]\[DifferentialD]{(Subscript[(UnderBar[x]), i]),(Subscript[(UnderBar[p]), i])})/.(Subscript[p, i])->(Subscript[p, i+1]);
lhs==rhs

Invariance Under Reidemeister 3b

lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ℒ[1,i,j]ℒ[1,i+1,k]ℒ[1,j+1,k+1]ℒ[0,i+1]ℒ[0,j+1]ℒ[0,k+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[vs, i+1]),(Subscript[vs, j+1]),(Subscript[vs, k+1])}
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ℒ[1,j,k]ℒ[1,i,k+1]ℒ[1,i+1,j+1]ℒ[0,i+1]ℒ[0,j+1]ℒ[0,k+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[vs, i+1]),(Subscript[vs, j+1]),(Subscript[vs, 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])]ℒ[1,i,j]ℒ[-1,i+1,j+1]ℒ[0,i+1]ℒ[0,j+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[vs, i+1]),(Subscript[vs, j+1])}

rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ[0,i+1]ℒ[0,j+1])ℒ[Dot,i]ℒ[Dot,j]ℒ[Dot,i+1]ℒ[Dot,j+1]\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[vs, i+1]),(Subscript[vs, j+1])}
lhs==rhs

Invariance Under R2c

lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ[-1,i,j+1]ℒ[1,i+1,j]ℒ[0,i+1]ℒ[1,j+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[vs, i+1]),(Subscript[vs, j+1])}

rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ℒ[Dot,i]ℒ[Dot,j]ℒ[Dot,i+1]ℒ[Dot,j+1]ℒ[0,i+1]ℒ[1,j+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[vs, i+1]),(Subscript[vs, j+1])};
lhs==rhs

Invariance Under R1l

lhs=8 (π^3)∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ[1,i+1,i]ℒ[1,i+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[vs, i+1])}
rhs=(2 π∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ[Dot,i])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i])})/.(Subscript[(UnderBar[p]), i+1])->(Subscript[(UnderBar[p]), i+2]);
lhs==rhs

Invariance Under R1r

lhs=8 (π^3)∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ[1,i,i+1]ℒ[-1,i+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[vs, i+1])}
rhs=(2 π∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ℒ[Dot,i])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i])})/.(Subscript[(UnderBar[p]), i+1])->(Subscript[(UnderBar[p]), i+2]);
lhs==rhs

Invariance Under Sw

CF/@{ℒ[1,j], ℒ[1,i,j]}

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