Pensieve header:  Finding the A2 $d=1$ invariant using undetermined coefficients.

Initialization

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

Features[Knot[8,17]]

Producing generic perturbations

mons0=MonomialList[
(Subscript[p, 3])(Subscript[x, 1])(Subscript[x, 2])/.
{(Subscript[(v:p|x), α_]):>(Subscript[v, α,i])+(Subscript[v, α,j])}
]/.c_Integer*mon_:>mon;
mons1=MonomialList[
1+(Subscript[p, 1])(Subscript[x, 1])+(Subscript[p, 2])(Subscript[x, 2])+(Subscript[p, 3])(Subscript[x, 3])+(Subscript[p, 1])(Subscript[p, 1])(Subscript[x, 1])(Subscript[x, 1])+(Subscript[p, 2])(Subscript[p, 2])(Subscript[x, 2])(Subscript[x, 2])+(Subscript[p, 1])(Subscript[p, 2])(Subscript[x, 1])(Subscript[x, 2])+(Subscript[p, 1])(Subscript[p, 3])(Subscript[x, 1])(Subscript[x, 3])+(Subscript[p, 2])(Subscript[p, 3])(Subscript[x, 2])(Subscript[x, 3])+(Subscript[p, 3])(Subscript[p, 3])(Subscript[x, 3])(Subscript[x, 3])+(Subscript[p, 1])(Subscript[p, 2])(Subscript[x, 3])/.
{(Subscript[(v:p|x), α_]):>(Subscript[v, α,i])+(Subscript[v, α,j])}
]/.c_Integer*mon_:>mon;
k=0;
(Subscript[r, 1])[1,i_,j_]:=Evaluate[Sum[(Subscript[c, ++k])mon,{mon,mons0}]+ϵ Sum[(Subscript[c, ++k])mon,{mon,mons1}]];
(Subscript[r, 1])[-1,i_,j_]:=Evaluate[Sum[(Subscript[c, ++k])mon,{mon,mons0}]+ϵ Sum[(Subscript[c, ++k])mon,{mon,mons1}]];
(Subscript[r, 1])[-1,4,7]

The A2 Integrand

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

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

Features[Knot[3,1]]

Short[ℒ[Knot[3,1]],10]

vs[Knot[3,1]]

Invariance Under Reidemeister 2b

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

{lhs}=Cases[∫𝔼[Sum[(Subscript[π, α,i])(Subscript[p, α,i])+(Subscript[π, α,j])(Subscript[p, α,j]),{α,3}]]ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,j+1])[-1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, i+1]),(Subscript[vs, j+1])}, ϵSeries[ℰ_]:>ℰ,∞]

{rhs}=Cases[∫𝔼[Sum[(Subscript[π, α,i])(Subscript[p, α,i])+(Subscript[π, α,j])(Subscript[p, α,j]),{α,3}]]ℒ/@((Subscript[C, i])[0](Subscript[C, i+1])[0](Subscript[C, j])[0](Subscript[C, j+1])[0])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, i+1]),(Subscript[vs, j+1])}, ϵSeries[ℰ_]:>ℰ,∞]

eqn=CF[lhs-rhs]

cvs=Union@Cases[eqn,(Subscript[p, __])|(Subscript[π, __]),∞]

eqns=CoefficientRules[eqn,cvs]/.(_->c_):>(c==0)

vars=Union@Cases[eqn,(Subscript[c, _]),∞]

{sol}=Solve[eqns,vars]

sol/.(v_->val_):>(v=CF[val])

Invariance Under Reidemeister 3b

Clear[k]

{lhs}=Cases[∫𝔼[Sum[(Subscript[π, α,i])(Subscript[p, α,i])+(Subscript[π, α,j])(Subscript[p, α,j])+(Subscript[π, α,k])(Subscript[p, α,k]),{α,3}]]ℒ/@((Subscript[X, i,j])[1](Subscript[X, i+1,k])[1](Subscript[X, j+1,k+1])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, k]),(Subscript[vs, i+1]),(Subscript[vs, j+1]),(Subscript[vs, k+1])}, ϵSeries[ℰ_]:>ℰ,∞]

{rhs}=Cases[∫𝔼[Sum[(Subscript[π, α,i])(Subscript[p, α,i])+(Subscript[π, α,j])(Subscript[p, α,j])+(Subscript[π, α,k])(Subscript[p, α,k]),{α,3}]]ℒ/@((Subscript[X, j,k])[1](Subscript[X, i,k+1])[1](Subscript[X, i+1,j+1])[1])\[DifferentialD]{(Subscript[vs, i]),(Subscript[vs, j]),(Subscript[vs, k]),(Subscript[vs, i+1]),(Subscript[vs, j+1]),(Subscript[vs, k+1])}, ϵSeries[ℰ_]:>ℰ,∞]

eqn=CF[lhs-rhs]

cvs=Union@Cases[eqn,(Subscript[p, __])|(Subscript[π, __]),∞]

eqns=CoefficientRules[eqn,cvs]/.(_->c_):>(c==0)

vars=Union@Cases[eqn,(Subscript[c, _]),∞]

{sol}=Solve[eqns,vars]

sol/.(v_->val_):>(v=CF[val])

vars=Union@Cases[eqn,(Subscript[c, _]),∞]

Factor@Cases[ℒ[(Subscript[X, i,j])[1]],ϵSeries[ℰ_]:>Coefficient[ℰ,(Subscript[c, 5])],∞]

Factor@Cases[ℒ[(Subscript[X, i,j])[1]],ϵSeries[ℰ_]:>Coefficient[ℰ,(Subscript[c, 110])],∞]

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