Pensieve header: The main lemma for  ${\mathfrak g}_1$ using $gl_2$.

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

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];
ϵ /: (ϵ^2)=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}];

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

Debt. How does this work?

Verifying the full (Subscript[𝔤, 1]) lemma

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 above.

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

Λ1=Λ /. {α->ℏ α,h->ℏ (Subscript[h, 1]),e->ℏ (Subscript[e, 1]),l->(Subscript[l, 1]),f->(Subscript[f, 1])}

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