Pensieve header: A first implementation of nilpotent integration.

Initialization

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

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[ℰ];
CCF[ℰ_] := Factor[ℰ];
CF[ℰ_List]:=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))] ];

Integration

Unprotect[Integrate];
∫ω_.𝔼[L_]\[DifferentialD](vs_List):=Module[{n,Q,G,V,s,t,k,a,b},
n=Length@vs;
Q=-Table[((∂_(vs[[a]],vs[[b]]))L)/.Thread[vs->0],{a,n},{b,n}];
G=Inverse[Q]/2;
V=L+vs.Q.vs/2;
s=t=V;k=0;
While[0=!=t,
s+=(1/((++k)!))(t=CF@Sum[G[[a,b]](((∂_(vs[[a]],vs[[b]]))t)+((∂_(vs[[a]]))t)((∂_(vs[[b]]))t)),{a,n},{b,n}])];
PowerExpand@Factor[ω(((Det[Q](((2π))^n)))^(-1/2))]𝔼[CF@s/.Thread[vs->0]]
];
Protect[Integrate];

∫𝔼[I λ (Subscript[x, 1]^2)/2]\[DifferentialD]{(Subscript[x, 1])}

∫𝔼[-I λ (Subscript[x, 1]^2)/2]\[DifferentialD]{(Subscript[x, 1])}

∫𝔼[(I/2){(Subscript[x, 1]),(Subscript[x, 2])}.(({{a, b}, {b, c}})).{(Subscript[x, 1]),(Subscript[x, 2])}]\[DifferentialD]{(Subscript[x, 1]),(Subscript[x, 2])}

∫𝔼[-λ (Subscript[x, 1]^2)/2]\[DifferentialD]{(Subscript[x, 1])}

∫𝔼[-(Subscript[x, 1]^2)/2+ξ (Subscript[x, 1])]\[DifferentialD]{(Subscript[x, 1])}

∫𝔼[-(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])}]\[DifferentialD]{(Subscript[x, 1]),(Subscript[x, 2])}

I1=∫𝔼[-(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])}]\[DifferentialD]{(Subscript[x, 1])}

∫I1 \[DifferentialD]{(Subscript[x, 2])}

∫𝔼[-(1/2){(Subscript[y, 1]),(Subscript[y, 2])}.(({{a, b}, {b, c}})).{(Subscript[y, 1]),(Subscript[y, 2])}+{(Subscript[η, 1]),(Subscript[η, 2])}.{(Subscript[y, 1]),(Subscript[y, 2])}]\[DifferentialD]{(Subscript[y, 1]),(Subscript[y, 2])}

I1=∫𝔼[-(1/2){(Subscript[y, 1]),(Subscript[y, 2])}.(({{a, b}, {b, c}})).{(Subscript[y, 1]),(Subscript[y, 2])}+{(Subscript[η, 1]),(Subscript[η, 2])}.{(Subscript[y, 1]),(Subscript[y, 2])}]\[DifferentialD]{(Subscript[y, 1])}

∫I1 \[DifferentialD]{(Subscript[y, 2])}

∫𝔼[ξ x+η y+z(x-y)+(x^2)]\[DifferentialD]{x,z}

The (Subscript[ρ, 1]) Integrand

Adopted from pensieve://Projects/APAI/PerturbedGaussianIntegration.nb.

q[s_,i_,j_]:=(Subscript[x, i]) ((Subscript[p, i])-(T^s) (Subscript[p, i+1])+((T^s)-1) (Subscript[p, j+1]))+(Subscript[x, j]) ((Subscript[p, j])-(Subscript[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])+(-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;
ℒ[s_,i_,j_]:=-q[s,i,j]+ϵ (Subscript[r, 1])[s,i,j];
(Subscript[γ, 1])[φ_,k_]:=ϵ φ (1/2-(Subscript[x, k])(Subscript[p, k]));
ℒ[φ_,k_]:=-(Subscript[x, k]) ((Subscript[p, k])-(Subscript[p, k+1]))+(Subscript[γ, 1])[φ,k];
ρ1i[K_]:=Module[{Cs,φ,n,s,i,j,k,vs,L},
{Cs,φ}=Rot[K]; n=Length[Cs];
L=-(Subscript[x, 2n+1])(Subscript[p, 2n+1]);
Cases[Cs,{s_,i_,j_}:>(L+=ℒ[s,i,j])];
L+=ϵ Sum[(Subscript[γ, 1])[φ[[k]],k],{k,2n}];
CF@(L+((O[ϵ])^2))
];
ρ1vs[K_] := Union@@Table[{(Subscript[x, i]),(Subscript[p, i])},{i,2Crossings[K]+1}]

ρ1i[Knot[3,1]]

ρ1vs[Knot[3,1]]

Integration of ϵ-Series

Unprotect[Integrate];
∫ω_.𝔼[L_SeriesData]\[DifferentialD](vs_List):=Module[{n,L0,Q,Δ,G,V,s,t,k,a,b},
n=Length@vs; L0=Normal@L/.ϵ->0;
Q=-Table[((∂_(vs[[a]],vs[[b]]))L0)/.Thread[vs->0]/.(Subscript[(p|x), __])->0,{a,n},{b,n}];
If[(Δ=CF@Det[Q])==0,Return["How dare you ask me to integrate a singular Gaussian!"]];
Echo@MatrixForm@Q;
G=Inverse[Q]/2;
V=L+vs.Q.vs/2;
s=t=V;k=0;
While[0=!=Normal@t,
s+=(1/((++k)!))(t=CF@Sum[G[[a,b]](((∂_(vs[[a]],vs[[b]]))t)+((∂_(vs[[a]]))t)((∂_(vs[[b]]))t)),{a,n},{b,n}])];
PowerExpand@Factor[ω(((Δ(((2π))^n)))^(-1/2))]𝔼[CF@s/.Thread[vs->0]]
];
Protect[Integrate];

∫𝔼[(Subscript[x, 1])(Subscript[p, 1])+ϵ (Subscript[x, 1]^7)(Subscript[p, 1]^7)+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, 1]),(Subscript[p, 1])}

∫𝔼[(Subscript[x, 1])(Subscript[p, 2])+ϵ (Subscript[x, 2]^7)(Subscript[p, 1]^7)+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, 1]),(Subscript[p, 2])}

∫𝔼[(Subscript[x, 1])(Subscript[p, 2])+3(Subscript[x, 2])(Subscript[p, 1])+ϵ (Subscript[p, 2]^5)(Subscript[x, 1]^5)+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[p, 1]),(Subscript[p, 2])}

∫𝔼[(Subscript[x, 1])(Subscript[p, 2])+(Subscript[x, 2])(Subscript[p, 3])+(Subscript[x, 3])(Subscript[p, 1])+ϵ (Subscript[x, 1]^5)(Subscript[p, 2]^5)+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}

MatrixForm@Table[
∫𝔼[(Subscript[x, 1])(Subscript[p, 2])+(Subscript[x, 2])(Subscript[p, 3])+(Subscript[x, 3])(Subscript[p, 1])+(Subscript[ξ, i])(Subscript[x, i])+(Subscript[π, j])(Subscript[p, j])]\[DifferentialD]{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3]),(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])},
{i,3},{j,3}]

K=Knot[5,2];
{ρ1i@K,ρ1vs@K}
∫𝔼[ρ1i@K]\[DifferentialD](ρ1vs@K)

K=Knot[8,19];
{ρ1i@K,ρ1vs@K}
∫𝔼[ρ1i@K]\[DifferentialD](ρ1vs@K)

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]+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, 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]+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[x, k]),(Subscript[p, i]),(Subscript[p, j]),(Subscript[p, k]),(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1])}

lhs==rhs

Invariance Under Reidemeister 3b - version 2

lhs=∫𝔼[ℒ[1,i,j]+ℒ[1,i+1,k]+ℒ[1,j+1,k+1]+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+1])}

rhs=∫𝔼[ℒ[1,j,k]+ℒ[1,i,k+1]+ℒ[1,i+1,j+1]+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, i+1]),(Subscript[x, j+1]),(Subscript[x, k+1]),(Subscript[p, i+1]),(Subscript[p, j+1]),(Subscript[p, k+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]+(Subscript[γ, 1])[-1,j+1]+((O[ϵ])^2)]\[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])+ℒ[0,i]+ℒ[0,i+1]+ℒ[0,j]+ℒ[-1,j+1]+((O[ϵ])^2)]\[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 R1l

lhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+ℒ[1,i+2,i]+ℒ[1,i+1]+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, i]),(Subscript[x, i+1]),(Subscript[x, i+2]),(Subscript[p, i]),(Subscript[p, i+1]),(Subscript[p, i+2])}

rhs=∫𝔼[(Subscript[π, i])(Subscript[p, i])+ℒ[0,i]+ℒ[0,i+1]+ℒ[0,i+2]+((O[ϵ])^2)]\[DifferentialD]{(Subscript[x, i]),(Subscript[x, i+1]),(Subscript[x, i+2]),(Subscript[p, i]),(Subscript[p, i+1]),(Subscript[p, i+2])}

lhs==rhs