Pensieve header: The $sl_2^{\leq k}$ program.

Some Shortcuts

ME[x_] := MatrixExp[x]; MF[x_] := MatrixForm[x];
SeriesOrder[sd_SeriesData] := sd[[ 5]]-1;

Representing ϵyax

(Borrowed from pensieve://2017-08/Multi-beta-yax.nb and pensieve://2017-09/QuantizedLogos.nb)

q=(E^(ℏ γ ϵ)); ρI=(({{1, 0}, {0, 1}})); ρy=(({{0, 0}, {-1, 0}})); ρa=(({{0, 0}, {0, -γ}}));ρx=(({{0, ((-1+(E^(-γ ϵ ℏ)))/ℏ)}, {0, 0}})); ρb=(({{ϵ, 0}, {0, 0}}));
ρt=Simplify[ϵ ρa-γ ρb]; ρA=ME[-ℏ ϵ ρa];  ρB=ME[-ℏ γ ρb];  ρT=ME[ℏ ρt];
(#->MF@Simplify@ToExpression@#)& /@ {"{{q}}", "ρy","ρa","ρx","ρb", "ρt", "ρA", "ρB", "ρT", "ρI"}

{ρa.ρx-ρx.ρa==γ ρx, ρx.ρA==q ρA.ρx, ρa.ρy-ρy.ρa==-γ ρy, ρb.ρy-ρy.ρb==-ϵ ρy, ρx.ρy-q ρy.ρx==(ρI-ρT.ρA.ρA)/ℏ} // Simplify

Limit[(ρI-ρT.ρA.ρA)/ℏ, ℏ->0]==-ρt+2ϵ ρa==ρt+2γ ρb==γ ρb+ϵ ρa

The 2-Stitch of Exponentials

eqn=(ME[τ1 ρt].ME[η1 ρy].ME[α1 ρa].ME[ξ1 ρx].ME[τ2 ρt].ME[η2 ρy].ME[α2 ρa].ME[ξ2 ρx])==(T0 ME[η0 ρy].ME[α0 ρa].ME[ξ0 ρx]);
sol=Solve[Thread[Flatten/@Expand[eqn]], {T0,η0,α0,ξ0}][[1]];
ϕ=sol /. (T0->ℰ_) :> (τ0 -> ((Log[ℰ])/(-ϵ γ))) /. (v_->ℰ_) :> (v->FullSimplify@PowerExpand[ℰ])

(Subscript[Φ, tot])=Simplify[t0 τ0 + y0 η0 + a0 α0 + x0 ξ0 /. ϕ]

(Subscript[Φ, 0]) = Collect[Limit[(Subscript[Φ, tot]), ϵ->0], {t0, y0, a0,xξ0}]

(Subscript[Φ, i])[k_]:=Series[(Subscript[Φ, tot])-(Subscript[Φ, 0]), {ϵ,0,k}];
(Subscript[Φ, i])[2]

Exp[(Subscript[Φ, i])[2]]

(Subscript[Φ, i])[3]

Differential Polynomials (DP)

(Subscript[DP, specs:(_->(Subscript[D, _]))..])[P_][f_] := Module[
{vs={specs}[[All,1]] (* variables *),
dvs={specs}[[All,2,2]] (* dual variables *),
ps (* powers *), c (* coefficient *)},
Total[
CoefficientRules[Normal@P,vs] /.
(ps_->c_) :> c D[f, Sequence@@Thread[{dvs,ps}]]
]
]

(Subscript[DP, ξ->(Subscript[D, x]),η->(Subscript[D, y])])[(ξ^2)(η^3)][(x^2)(y^4)]

Stitching

(Subscript[m, i_,j_->k_])[𝔼[ω_,L_,Q_,P_]] := Module[{F, K, ν, δ},
F=Exp[(Subscript[Φ, i])[SeriesOrder@P]];
K=ν(ξ x+η y+δ x y-t ξ η);

]