Pensieve header: A first implementation of nilpotent integration (first to use Picard iteration).

Initialization

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

CCF[ℰ_] := ExpandDenominator@ExpandNumerator@Together[ℰ];
CCF[ℰ_] := Factor[ℰ];
CF[ω_.ℰ_𝔼]:=CF[ω]CF/@ℰ;
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

Using Picard Iteration!

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

$π=Identity;

Unprotect[Integrate];
Integrate::sing="How dare you ask me to integrate a singular Gaussian!";
∫ω_.𝔼[L_]\[DifferentialD](vs_List):=Module[{n,L0,Q,Δ,G,Z,e,λ,a,b},
n=Length@vs; L0=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,Message[Integrate::sing]; Return[]];
Z=CF@$π[L+vs.Q.vs/2]; G=Inverse[Q];
While[
e=CF@$π[((∂_λ)Z)-(1/2)(∑_(a=1)^n)(∑_(b=1)^n)G[[a,b]](((∂_(vs[[a]],vs[[b]]))Z)+((∂_(vs[[a]]))Z)((∂_(vs[[b]]))Z))];
0=!=e,Z-=(∫_0^λ)e \[DifferentialD]λ
];
PowerExpand@Factor[ω(((Δ(((2π))^n)))^(-1/2))]𝔼[CF[Z/.λ->1/.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])}

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

Integration of ϵ-Series

Block[{$π=Normal[#+((O[ϵ])^7)]&},
∫𝔼[-(x^2)/2+ϵ (x^3)/6]\[DifferentialD]{x}]

Block[{$π=Normal[#+((O[ϵ])^7)]&},
∫𝔼[-(ϕ^2)/2+ϵ (ϕ^4)/24]\[DifferentialD]{ϕ}]

Block[{$π=Normal[#+((O[ϵ])^5)]&},
∫𝔼[p x+ϵ (p^2)x]\[DifferentialD]{p,x}]

Block[{$π=Total@Select[MonomialList[#,{ϵ, x,p}],
mon|->And[
Exponent[mon,ϵ]<=2,
Exponent[mon,x]==Exponent[mon,p]
]
]&},
∫𝔼[p x+a (x^2)p+ϵ b (x^3)(p^3)]\[DifferentialD]{p,x}]

Block[{$π=Total@Select[MonomialList[#,{ϵ,x,p}],
mon|->And[
Exponent[mon,ϵ]<4,
Exponent[mon,x]-Exponent[mon,p]<=3
]
]&},
∫𝔼[p x+a (x^2)p+ϵ b (p^2)x]\[DifferentialD]{p,x}]

Block[{$π=Total@Select[MonomialList[#,{ϵ,x,p}],
mon|->And[
Exponent[mon,ϵ]<4,
Exponent[mon,x]-Exponent[mon,p]<=3-Exponent[mon,ϵ]
]
]&},
∫𝔼[p x+a (x^2)p+ϵ b (p^2)x]\[DifferentialD]{p,x}]

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}]

The (Subscript[ρ, 1]) Integrand

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

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

ρ1i[Knot[3,1]]

ρ1vs[Knot[3,1]]

K=Knot[5,2];
Block[{$π=Normal[#+((O[ϵ])^2)]&},
ρ1i[K]]

K=Knot[5,2];
Block[{$π=Normal[#+((O[ϵ])^2)]&},
∫ρ1i[K]\[DifferentialD](ρ1vs@K)]

K=Knot[8,19];
Block[{$π=Normal[#+((O[ϵ])^2)]&},
∫ρ1i@K\[DifferentialD](ρ1vs@K)]

Concatenating edges

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ρ1i[φ1,i]ρ1i[φ2,i+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ρ1i[φ1+φ2,i])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i])}]

Invariance Under Reidemeister 3b

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ρ1i[1,i,j]ρ1i[1,i+1,k]ρ1i[1,j+1,k+1]ρ1i[0,i]ρ1i[0,j]ρ1i[0,k]ρ1i[0,i+1]ρ1i[0,j+1]ρ1i[0,k+1])\[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])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, k])(Subscript[p, k])]ρ1i[1,j,k]ρ1i[1,i,k+1]ρ1i[1,i+1,j+1]ρ1i[0,i]ρ1i[0,j]ρ1i[0,k]ρ1i[0,i+1]ρ1i[0,j+1]ρ1i[0,k+1])\[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 2b

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[ξ, i+1])(Subscript[x, i+1])+(Subscript[ξ, j+1])(Subscript[x, j+1])]ρ1i[1,i,j]ρ1i[-1,i+1,j+1]ρ1i[0,i]ρ1i[0,j]ρ1i[0,i+1]ρ1i[0,j+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])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[ξ, i+1])(Subscript[x, i+1])+(Subscript[ξ, j+1])(Subscript[x, j+1])]ρ1i[0,i]ρ1i[0,j]ρ1i[0,i+1]ρ1i[0,j+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])}]

lhs==rhs

Invariance Under R2c

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ρ1i[-1,i,j+1]ρ1i[1,i+1,j]ρ1i[0,i]ρ1i[0,j]ρ1i[0,i+1]ρ1i[1,j+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])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ρ1i[0,i]ρ1i[0,j]ρ1i[0,i+1]ρ1i[1,j+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])}]

lhs==rhs

Invariance Under R1l

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ρ1i[1,i+1,i]ρ1i[0,i]ρ1i[1,i+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ρ1i[0,i]ρ1i[0,i+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1])}]

lhs==rhs

Invariance Under R1r

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ρ1i[1,i,i+1]ρ1i[0,i]ρ1i[-1,i+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])]ρ1i[0,i]ρ1i[0,i+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[p, i]),(Subscript[x, i+1]),(Subscript[p, i+1])}]

lhs==rhs

Invariance Under Sw

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ρ1i[1,i,j]ρ1i[-1,i]ρ1i[1,i+1]ρ1i[-1,j]ρ1i[1,j+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])]ρ1i[1,i,j]ρ1i[0,i]ρ1i[0,i+1]ρ1i[0,j]ρ1i[0,j+1])\[DifferentialD]{(Subscript[x, i]),(Subscript[x, j]),(Subscript[p, i]),(Subscript[p, j])}]

lhs==rhs

Block[{$π=Normal[#+((O[ϵ])^2)]&},
lhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, i+1])(Subscript[p, i+1])+(Subscript[π, j+1])(Subscript[p, j+1])+(Subscript[ξ, i+1])(Subscript[x, i+1])+(Subscript[ξ, j+1])(Subscript[x, j+1])]ρ1i[1,i,j]ρ1i[-1,i]ρ1i[1,i+1]ρ1i[-1,j]ρ1i[1,j+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])}]

Block[{$π=Normal[#+((O[ϵ])^2)]&},
rhs=∫(𝔼[(Subscript[π, i])(Subscript[p, i])+(Subscript[π, j])(Subscript[p, j])+(Subscript[π, i+1])(Subscript[p, i+1])+(Subscript[π, j+1])(Subscript[p, j+1])+(Subscript[ξ, i+1])(Subscript[x, i+1])+(Subscript[ξ, j+1])(Subscript[x, j+1])]ρ1i[1,i,j]ρ1i[0,i]ρ1i[0,i+1]ρ1i[0,j]ρ1i[0,j+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])}]

lhs==rhs