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

Initialization

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

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[X, i_,j_])[s_]]:=(Subscript[T, 3]^s)𝔼[-q[s,i,j]+ϵ (Subscript[r, 1])[s,i,j]+((O[ϵ])^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])];

The PXX Coefficients from R3

mons=MonomialList[
(Subscript[p, 3])(Subscript[x, 1])(Subscript[x, 2])/.
{(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,mons}]];
Clear[k];
(Subscript[r, 1])[1,j,k]

{lhs}=Cases[∫𝔼[(Subscript[π, 1,i])(Subscript[p, 1,i])+(Subscript[π, 2,i])(Subscript[p, 2,i])+(Subscript[π, 1,j])(Subscript[p, 1,j])+(Subscript[π, 2,j])(Subscript[p, 2,j])+(Subscript[π, 1,k])(Subscript[p, 1,k])+(Subscript[π, 2,k])(Subscript[p, 2,k])]ℒ/@((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[∫𝔼[(Subscript[π, 1,i])(Subscript[p, 1,i])+(Subscript[π, 2,i])(Subscript[p, 2,i])+(Subscript[π, 1,j])(Subscript[p, 1,j])+(Subscript[π, 2,j])(Subscript[p, 2,j])+(Subscript[π, 1,k])(Subscript[p, 1,k])+(Subscript[π, 2,k])(Subscript[p, 2,k])]ℒ/@((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, _]),∞]

ℒ[(Subscript[X, i,j])[1]]

(Subscript[r, 1])[1,i,j]

The XPP Coefficients from R3

mons=MonomialList[
(Subscript[x, 3])(Subscript[p, 1])(Subscript[p, 2])/.
{(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[d, ++k])mon,{mon,mons}]];
Clear[k];
(Subscript[r, 1])[1,j,k]

{lhs}=Cases[∫𝔼[(Subscript[π, i])(Subscript[p, 3,i])+(Subscript[π, j])(Subscript[p, 3,j])+(Subscript[π, k])(Subscript[p, 3,k])]ℒ/@((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[∫𝔼[(Subscript[π, i])(Subscript[p, 3,i])+(Subscript[π, j])(Subscript[p, 3,j])+(Subscript[π, k])(Subscript[p, 3,k])]ℒ/@((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[d, _]),∞]

{sol}=Solve[eqns,vars]

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

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

ℒ[(Subscript[X, i,j])[1]]

(Subscript[r, 1])[1,i,j]