Pensieve header: The Logos at $k=2$, adapted from pensieve://Classes/17-1350-AKT/nb/170307-geps.pdf.

Representing (𝔤^ϵ)=⟨h,e,l,f⟩/([e,l]=-e, [f,l]=f, [e,f]=h-2ϵ l, [h,*]=0)

ρh=(({{-1, 0}, {0, -1}}));  ρe=(({{0, 0}, {-ϵ, 0}}));  ρl=(({{-(1+1/ϵ)/2, 0}, {0, (1-1/ϵ)/2}})); ρf=(({{0, 1}, {0, 0}}));
MB[x_?MatrixQ, y_?MatrixQ] := x.y-y.x;
Simplify@{MB[ρe,ρl]==-ρe, MB[ρf,ρl]==ρf, MB[ρe,ρf]==ρh-2ϵ ρl}

MatrixExp[α ρf].MatrixExp[β ρe] // Simplify // MatrixForm

eqn=MatrixExp[α ρf].MatrixExp[β ρe]==MatrixExp[a ρe].MatrixExp[c (ρh-2ϵ ρl)].MatrixExp[b ρf]

sol=Solve[Thread[Flatten/@eqn], {a,b,c}][[1]]

sol=sol/.C[1]->0

And so,
3. 𝕆((e^(α f + β e))|f e)=𝕆((e^(c h + a e - 2ϵ c l + b f))|e l f), with {a->-(β/(-1+α β ϵ)),b->-(α/(-1+α β ϵ)),c->((Log[1-α β ϵ])/ϵ)}.

At ϵ=0 get

Limit[{a,b,c}/.sol,ϵ->0]

The k=1 logos

Series[{a,b,c}/.sol,{ϵ,0,1}] // Normal

λ1=Simplify[(E^(-f α-e β+h α β))Normal@Series[(E^(c h + a e - 2ϵ c l + b f))/.sol, {ϵ,0,1}]]

Which means 𝕆((e^(α f + β e))|f e)=𝕆((e^(-α β h + β e  + α f))(1+ϵ(2 l α β+f (α^2) β+e α (β^2)-(1/2) h (α^2) (β^2)))|e l f).

And so,
3. 𝕆((e^(α f + β e + δ e f))|f e)=𝕆(ν(1+ϵ Λ)(e^(ν(-h α β + α f + β e + δ e f)))|e l f), with ν=(((1+h δ))^(-1)) and Λ, the “logos”, as below.

(Subscript[DP, x_->(Subscript[D, α_]),y_->(Subscript[D, β_])])[P_][f_]:=Total[CoefficientRules[P,{x,y}]/.({m_,n_}->c_):>c D[f,{α,m},{β,n}]]

Λ1=Collect[
With[{q=(E^(ν(f α+e β-h α β+e f δ)))}, (q^(-1))(Subscript[DP, α->(Subscript[D, f]),β->(Subscript[D, e])])[λ1][q] /. ν->(((1+h δ))^(-1))],
ϵ,Simplify]

oldΛ=Simplify[(1/(2 (μ^4)))(-b (α^2) (β^2)+(u^2) (β^2) δ (2+b δ)+(w^2) δ (α+u δ) (α (2+b δ)+u δ (4+3 b δ))-4 b α β δ μ+4 c α β (μ^2)-2 b (δ^2) (μ^2)+4 c δ (μ^3)+2 u β (α β+2 δ μ (1+c μ))+2 w ((α^2) β+2 α δ (u β (2+b δ)+μ (1+c μ))+u (δ^2) (u β (3+2 b δ)+2 μ (2+b δ+c μ)))) /. {μ->(ν^(-1)),b->h,c->l,u->e,w->f}]

Simplify[Λ1==1+ϵ oldΛ /. ν->(((1+h δ))^(-1))]

The k=2 logos

Series[{a,b,c}/.sol,{ϵ,0,2}] // Normal

λ2=Simplify[(E^(-f α-e β+h α β))Normal@Series[(E^(c h + a e - 2ϵ c l + b f))/.sol, {ϵ,0,2}]]

Λ2=Collect[
With[{q=(E^(ν(f α+e β-h α β+e f δ)))}, (q^(-1))(Subscript[DP, α->(Subscript[D, f]),β->(Subscript[D, e])])[λ2][q] /. ν->(((1+h δ))^(-1))],
ϵ,Simplify]

(Λ2/.(ϵ^2)->0)==Λ1

Implementing (Subscript[𝔤, 1]) at k=2

PBWRule={e->1,l->2,f->3};
B[U@e,U@l]=-U@e; B[U@f,U@l]=U@f; B[U@e,U@f]=h U[]-2ϵ U[l];
ϵ /: (ϵ^(3|4))=0;

$TD=3; ℏ /: (ℏ^(d_. ))/;d>$TD :=0;

x_⪯y_:=OrderedQ[{x,y}/.PBWRule]; x_≺y_:=!OrderedQ[{y,x}/.PBWRule];
Simp[ℰ_]:= Collect[ℰ, _U, Expand];

(Subscript[U, i_])[ℰ_] := ℰ /. {h->(Subscript[h, i]),t->(Subscript[t, i]), u_U :> Replace[u, x_ :> (Subscript[x, i]),1]};
B[U[(Subscript[(x_), i_])],U[(Subscript[(y_), i_])]]:=B[U[(Subscript[x, i])],U[(Subscript[y, i])]]=(Subscript[U, i])[B[U@x,U@y]];
B[U[(Subscript[(x_), i_])],U[(Subscript[(y_), j_])]] /; i=!=j := 0;
B[x_,x_]=0;
B[U[y_],U[x_]]:=B[U[y],U[x]]=Simp[-B[U[x],U[y]]];
B[x_,y_] := x**y-y**x;

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[x_] := x;
0**_=_**0=0;
x_**U[]:=x; U[]**x_:=x;
(a_*x_U)**(b_*y_U) := If[a b === 0, 0, Simp[a b (x**y)]];
(a_*x_U)**y_ := Simp[a(x**y)]; x_**(a_*y_U) := Simp[a(x**y)];
(x_Plus)**y_ := (#**y)& /@ x; x_**(y_Plus) := (x**#)& /@ y;

U[xx___,x_] ** U[y_,yy___] := If[x⪯y,U[xx,x,y,yy], U@xx**(U@y**U@x+B[U@x,U@y])**U@yy];

UU[l___,((x_)^(n_)),r___]:= UU[l,Sequence@@Table[x,{n}],r];
UU[l___,1,r___]:= UU[l,r];
UU[]=U[];
UU[l_,r___]:=U[l]**UU[r];

UProducts[{},0]={UU[]};
UProducts[{},n_Integer] /; n>0 = {};
UProducts[{x_,xs___}, n_Integer] := Sort@Flatten@Table[UU[(x^k)]**u, {k,0,n},{u,UProducts[{xs},n-k]}];
UProducts[xs_List, k_Integer, n_Integer] := UProducts[Flatten@Table[(Subscript[x, j]), {x,xs}, {j,k}], n];
UProducts[any__, {n_}] := Flatten@Table[UProducts[any,k], {k,0,n}];

(Subscript[r, i_,j_]):=Simp[ℏ ((Subscript[h, i])UU[(Subscript[l, j])]+ UU[(Subscript[e, i]),(Subscript[f, j])])]

UExp[u_]:=Module[{s,t,k},
s=t=U[]; k=0;
While[k<20∧0=!=(t=t**u), s+=t/(++k)!];
Simp[s]];
(Subscript[R, i_,j_]):=UExp[(Subscript[r, i,j])];

m[i_,j_,k_][ℰ_] := Simp[ℰ /. {
u_U :> UU@@Join[DeleteCases[u,(Subscript[x_, i|j])],U@@Cases[u,(Subscript[x_, i]):>(Subscript[x, k])],U@@Cases[u,(Subscript[x_, j]):>(Subscript[x, k])]],
(Subscript[h, i|j])->(Subscript[h, k])}]

𝕆[poly_, specs___] := Module[{vs,us,z},
vs=Join@@(First /@ {specs});
us=Join@@({specs} /. (l_->s_) :> (l/.(Subscript[x_, i_]):>(Subscript[x, s])));
Simp@Total[CoefficientRules[Normal@Series[poly, {ℏ,0,$TD}], vs] /. (p_->c_) :> c UU@@((us^p))]
]

Verifying the full (Subscript[𝔤, 1]) lemma at k=2

3. 𝕆((e^(α f + β e + δ e f))|f e)=𝕆(ν (Subscript[Λ, 2])(e^(ν(-h α β + α f + β e + δ e f)))|e l f), with ν=(((1+h δ))^(-1)) and (Subscript[Λ, 2]), the “2-logos”, as above.

degrule={α->ℏ α,h->ℏ (Subscript[h, 1]),e->ℏ (Subscript[e, 1]),l->(Subscript[l, 1]),f->(Subscript[f, 1]),ϵ->ℏ ϵ};

$TD=2;𝕆[(E^(α f+β e+δ e f))/.degrule, {(Subscript[f, 1]),(Subscript[e, 1])}->1]

$TD=10; Simp[
 𝕆[(E^(α f+β e+δ e f))/.degrule, {(Subscript[f, 1]),(Subscript[e, 1])}->1]-𝕆[ν Λ2 (E^(ν(-α β h+α f+β e+δ e f)))/.ν->(((1+h δ))^(-1))/.degrule,{(Subscript[e, 1]),(Subscript[l, 1]),(Subscript[f, 1])}->1]
]

The k=3 logos

Clear[ϵ]

Series[{a,b,c}/.sol,{ϵ,0,3}] // Normal

λ3=Simplify[(E^(-f α-e β+h α β))Normal@Series[(E^(c h + a e - 2ϵ c l + b f))/.sol, {ϵ,0,3}]]

Λ3=Collect[
With[{q=(E^(ν(f α+e β-h α β+e f δ)))}, (q^(-1))(Subscript[DP, α->(Subscript[D, f]),β->(Subscript[D, e])])[λ3][q] /. ν->(((1+h δ))^(-1))],
ϵ,Simplify]

Collect[Λ1/.x:(α|β|e|l|f):>ℏ x, ℏ, Simplify]

Collect[Λ2/.x:(α|β|e|l|f):>ℏ x, ℏ, Simplify]

Collect[Λ3/.x:(α|β|e|l|f):>ℏ x, ℏ, Simplify]