Pensieve header: The main lemma for  ${\mathfrak g}_1$ using $gl_2$ (aborted re-implementation of the UEA section).

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}

Some (𝔤^ϵ) lemmas

1. 𝕆((e^(γ l+β e))|l e)=𝕆((e^(γ l+(e^γ)β e))|e l).
2. 𝕆((e^(γ l+β f))|f l)=𝕆((e^(γ l+(e^γ)β f))|l f).

Proofs.

MatrixForm /@ {MatrixExp[γ ρl].MatrixExp[β ρe], MatrixExp[(E^γ)β ρe].MatrixExp[γ ρl]}

MatrixForm /@ {MatrixExp[β ρf].MatrixExp[γ ρl], MatrixExp[γ ρl].MatrixExp[(E^γ)β ρf]}

Deriving “lemma 3 at δ=0”:

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

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 full (Subscript[𝔤, 1]) lemma

At (ϵ^2)=0 get

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

Collect[Series[(E^(c h + a e - 2ϵ c l + b f))/.sol, {ϵ,0,1}]//Normal, (E^(_)), Expand]

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.

Λ=With[{q=(E^(ν(f α+e β-h α β+e f δ)))}, Simplify[(q^(-1))(2 l(∂_(f,e))q+f (∂_(f,f,e))q+e (∂_(f,e,e))q-(1/2) h(∂_(f,f,e,e))q)]]

(The below is private; don’t look)

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[Λ==oldΛ /. ν->(((1+h δ))^(-1))]

Implementing general universal enveloping algebras

B[0,_]=0; B[_,0]=0;
B[c_*x_,y_]/; MemberQ[$Basis,x]:=Expand[c B[x,y]];
B[y_,c_*x_]/; MemberQ[$Basis,x]:=Expand[c B[y,x]];
B[x_Plus,y_] := B[#,y]& /@ x;
B[x_,y_Plus] := B[x,#]& /@ y;
B[x_,x_] =0;
B[y_,x_] := Expand[-B[x,y]];

x_⪯y_:=OrderedQ[{x,y}/.$PBWRule]; x_≺y_:=!OrderedQ[{y,x}/.$PBWRule];
(Subscript[UU, i_])[ℰ_] := ℰ /. x_ /; MemberQ[$Basis,x]:>(Subscript[U, i])[x];
USimp[ℰ_]:= Collect[ℰ, Times[(Subscript[U, _])[__]..], Expand];
USimp[ℰ_]:=Expand[ℰ];

(Subscript[m, s__])[0]=0; (Subscript[m, s__])[x_Plus] := (Subscript[m, s])/@x;
(Subscript[m, i_->j_])[ℰ_] := ℰ /. (Subscript[U, i])->(Subscript[U, j]);

(Subscript[m, i_,j_->k_])[c_. (Subscript[U, i_])[x___](Subscript[U, j_])[]]:=c (Subscript[U, k])[x];
(Subscript[m, i_,j_->k_])[c_. (Subscript[U, i_])[](Subscript[U, j_])[y___]]:=c (Subscript[U, k])[y];
(Subscript[m, i_,j_->k_])[c_. (Subscript[U, i_])[xx___,x_](Subscript[U, j_])[y_,yy___]]:=If[x⪯y,
c (Subscript[U, k])[xx,x,y,yy],
(((Subscript[U, i])[xx]((Subscript[U, j])[y,x]+(Subscript[UU, j])[B[x,y]]) // Expand // (Subscript[m, i,j->i]))(Subscript[U, j])[yy] // Expand // (Subscript[m, i,j->k]))c // USimp
];

UProducts[{},0]={1}; UProducts[{},d_Integer] /; d>0 = {};
UProducts[{i_,is___}, d_Integer] := Sort@Flatten@Table[((Subscript[U, i])@@@Subsets[$Basis,{j}])u, {j,0,d},{u,UProducts[{is},d-j]}];

S[ℰ_]:= Union@Cases[{ℰ}, (Subscript[U, i_])[___]:>i, ∞];

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[x_] := x;
x_**y_ := Module[{is=S[x]⋂S[y],σ,z},
z=x; Do[z=(Subscript[m, i->σ@i])[z], {i,is}];
z=Expand[y z]; Do[z=(Subscript[m, σ@i,i->i])[z], {i,is}]; z];
UB[x_,y_] := USimp[x**y-y**x];

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

B[e,l]=-e; B[f,l]=f; B[e,f]=h-2ϵ l;  B[h,_]=0;
$Basis={h,e,l,f};
$PBWRule = {h->1,e->2,l->3,f->4};

Table[{x,y}->B[x,y],{x,$Basis}, {y,$Basis}]// MatrixForm

Module[{x,y},Union@Table[{x,y}=t; B[x,y]+B[y,x],{t, Tuples[$Basis, 2]}]]

Module[{x,y,z}, DeleteCases[Table[
({x,y,z}=t)-> B[x,B[y,z]]+B[y,B[z,x]]+B[z,B[x,y]],
{t, Tuples[$Basis, 3]}
], _->0]]

Union[(u|->(Subscript[m, 1,3->1])[(Subscript[m, 1,2->1])[u]]-(Subscript[m, 1,2->1])[(Subscript[m, 2,3->2])[u]])/@UProducts[{1,2,3},3]]

(Subscript[r, i_,j_]):=USimp[(Subscript[U, i])[e](Subscript[U, j])[f]+((Subscript[U, i])[h]-ϵ (Subscript[U, i])[l])(Subscript[U, j])[l]];
(Subscript[r, 1,2])

UB[(Subscript[r, 1,2]),(Subscript[r, 1,3])]+UB[(Subscript[r, 1,2]),(Subscript[r, 2,3])]+UB[(Subscript[r, 1,3]),(Subscript[r, 2,3])]

$TD=3;
𝕆[poly_, specs_] := Module[{rules,vars,gens},
rules=Cases[specs, _Rule, ∞];
vars=First/@rules;
gens=Last/@rules;
(* Wrong/unfinished: USimp@Total[CoefficientRules[Normal@Series[poly, {ℏ,0,$TD}], vars] /. (p_->c_) :> c UU@@((us^p))]*)
]

Debt. How does this work?

CoefficientRules[(((x+y))^3),{x,y}]