Pensieve header: The PBW multiplication tensor for  $gl_{n,\epsilon}$ using the nilpotent-only $\lambda$-tangent formalism. Some material from pensive://Projects/glneps and from pensieve://Projects/UEA.

SetDirectory@"C:\\drorbn\\AcademicPensieve\\Projects\\SolvablePBW";
<< KnotTheory`

Conventions

(Subscript[x, α,β]) is always with α<=β and represents a basis element of the upper triangular matrices. (Subscript[y, α,β]) is always with β<=α and represents a basis element of the lower triangular matrices. The adjoint of (Subscript[x, α,β]) is (Subscript[y, β,α]).

Variable declarations:

VarPattern=((y|x|η|ξ)|(Subscript[(y|x|η|ξ), __]))[_];

Greek - Latin duality:

{(SuperStar[y]),(SuperStar[x]),(SuperStar[η]),(SuperStar[ξ])}={η,ξ,y,x}; 
(SuperStar[((Subscript[u_, αβ__]))]):=(Subscript[((SuperStar[u])), αβ]);
(SuperStar[((u:((y|x|η|ξ)|(Subscript[(y|x|η|ξ), __])))[i_])]):=(SuperStar[u])[i];
(SuperStar[(vs_List)]):=(v|->(SuperStar[v]))/@vs;

(SuperStar[{(Subscript[x, 1,2]),(Subscript[y, 2,3]),(Subscript[η, 1,2])[7]}])

Weights:

({{Wt[(Subscript[x, α_,β_])]:={1,α-β};, Wt[(Subscript[y, α_,β_])]:={0,α-β};}, {Wt[(Subscript[ξ, α_,β_])]:={0,β-α};, Wt[(Subscript[η, α_,β_])]:={1,β-α};}});
Wt[u_[_]] := Wt[u];

The Engine

Canonical Forms:

LogReduce[ℰ_]:=ℰ/.c_*Log[a_]:>Log@Factor[(a^c)]//.Log[a_]+Log[b_]:>Log@Factor[a b];
CF[ℰ_] := Expand@Collect[ℰ,Cases[ℰ,VarPattern,∞],CCF]/.CCF->Factor;
CF[ℰ_𝔼]:=CF/@MapAt[LogReduce,ℰ,1];
CF[ℰ:(Subscript[𝔼, __])[___]]:=CF/@ℰ;

𝔼 operations:

ℰ_𝔼[$]:=Length[ℰ]-1; (Subscript[𝔼, _])[ℰs___][$]:=𝔼[ℰs][$];ℰ_𝔼[k_Integer]:=ℰ[[k+1]]; (Subscript[𝔼, _])[ℰs___][k_Integer]:={ℰs}[[k+1]];
𝔼/:ℰ1_𝔼≡ℰ2_𝔼:=Inner[CF@#1==CF@#2&, ℰ1,ℰ2,And];
(Subscript[𝔼, d1_->r1_])[ℰ1s___]≡(Subscript[𝔼, d2_->r2_])[ℰ2s___] ^:= (d1==d2)∧(r1==r2)∧(𝔼[ℰ1s]≡𝔼[ℰ2s]);
𝔼/:ℰ1_𝔼*ℰ2_𝔼:=𝔼@@Table[CF[ℰ1[kk]+ℰ2[kk]],{kk,0,Min[ℰ1[$],ℰ2[$]]}];
(Subscript[𝔼, d1_->r1_])[ℰ1s___](Subscript[𝔼, d2_->r2_])[ℰ2s___] ^:= (Subscript[𝔼, (d1⋃d2)->(r1⋃r2)])@@(𝔼[ℰ1s]𝔼[ℰ2s]);

(Subscript[𝔼, d1_->r1_])[ℰ1s___]//(Subscript[𝔼, d2_->r2_])[ℰ2s___] :=Module[{is=r1⋂d2,lvs,llvs},
lvs=Cases[{ℰ1s},(Subscript[(x|y), __])[i_]/;MemberQ[is,i],∞]⋃(SuperStar[Cases[{ℰ2s},(Subscript[(ξ|η), __])[i_]/;MemberQ[is,i],∞]]);
llvs=Map[$,lvs,{2}];
(Subscript[𝔼, (d1⋃Complement[d2,is])->(r2⋃Complement[r1,is])])@@((Subscript[Zip, llvs⋃(SuperStar[llvs])])[{(SuperStar[(llvs)]).(llvs),Times[
𝔼[ℰ1s]/.Thread[lvs->llvs],
𝔼[ℰ2s]/.Thread[(SuperStar[lvs])->(SuperStar[llvs])]
]}])
]

Zipping! Lemmas 2 and 3 are combined, yet they must be applied first to the middle weight variables and then to the heavy and light variables.

Comment. Zip3 of the outer variables must occur after all other operations are completed, because we must allow for gluings of the weight n variables in perturbations with the weight 0 variables in the coefficients of Q.

dvs stands for “Diagonal Variables”. In (Subscript[gl, n]) they are the (Subscript[x, ii])’s and the (Subscript[y, ii])’s. They have weights {1,0} and {0,0}.

(Subscript[Zip, vs_])[{ℱ_,ℰ_}]:=Module[{dvs=Select[vs,(Wt[#]=={0,0}∨Wt[#]=={1,0})&]},
{ℱ,ℰ}//(Subscript[Zip1, vs])(*//(Subscript[Zip2, Complement[vs,dvs]])*)//(Subscript[Zip2, dvs])//(Subscript[Zip3, Complement[vs,dvs]])//(Subscript[Zip3, dvs])
]//Last

Getting rid of the quadratic.

(Subscript[Zip1, {}])=Identity;
(Subscript[Zip1, vs_])@{ℱ_,𝔼[Q_,P___]} := Module[{ℐ,F,G,u,v},
ℐ=IdentityMatrix@Length@vs;
F=Table[If[Wt[u]+Wt[v]=={1,0},(∂_(u,v))ℱ,0],{u,vs},{v,vs}];
G=Table[If[Wt[u]+Wt[v]=={1,0},(∂_(u,v))Q,0],{u,vs},{v,vs}];
{CF[(vs).(F.Inverse[ℐ-G.F]).(vs)/2], 𝔼[CF[Q-PowerExpand@Log[Det[ℐ- G.F]]/2-vs.G.vs/2],P]}
]

Getting rid of linear terms.

(Subscript[Zip2, {}])=Identity;
(Subscript[Zip2, vs_])@{ℱ_,𝔼[Q_,P___]} := Module[{F,Y,u,v},
F=Table[If[Wt[u]+Wt[v]=={1,0},CF[(∂_(u,v))ℱ],0],{u,vs},{v,vs}];
Y=Table[(∂_v)Q,{v,vs}]/.Table[v->0,{v,vs}];
CF/@{ℱ, 𝔼[Q-Y.vs+Y.F.Y/2, P]/.Thread[vs->vs+F.Y]}
]

Dealing with Feynman diagrams.

Note that the power m of λ is at most k-1+((2k+2)/2)=2k. We write (Subscript[Z, λ])=∑Z[m](λ^m).

(Subscript[Zip3, vs_])@{ℱ_,ℰ_𝔼} := Module[{F,u,v,Z,kk,jj,$m=0,m,n},
Do[Z[0,kk]=ℰ[[kk+1]],{kk,0,ℰ@$}];
F[u_,v_]:=F[u,v]=CF@If[Wt[u]+Wt[v]=={1,0},(∂_(u,v))ℱ,0];
Z[m_,kk_,u_]:=Z[m,kk,u]=(∂_u)Z[m,kk];
Z[m_,kk_,u_,v_]:=Z[m,kk,u,v]=(∂_v)Z[m,kk,u];
For[m=0,m≤2$m,++m,For[kk=0,kk≤ℰ@$,++kk,
Z[m+1,kk]=CF@Sum[
If[F[u,v]===0,0,((F[u,v])/(2(m+1)))(Z[m,kk,u,v]+Sum[Z[n,jj,u]*Z[m-n,kk-jj,v],{n,0,m},{jj,0,kk}])],
{u,vs},{v,vs}];
If[Z[m+1,kk]=!=0, $m=m+1]
]];
CF/@({
ℱ-Sum[F[u,v]*u*v/2,{u,vs},{v,vs}],
𝔼@@Table[Sum[Z[m,kk],{m,0,$m}],{kk,0,ℰ@$}]
}/.Table[v->0,{v,vs}])
]

Prolog

BeginPackage["UEA`"];
Print["UEA` does computations in general universal enveloping algebras and PBW algebras. It is in the public domain, available at http://drorbn.net/AcademicPensieve/Projects/SolvablePBW/. Dror Bar-Natan is committed to support it within reason until June 1, 2027. This is version 260601."];
Print["UEA` implements / extends ",
Sort@{"**",ϵ,$k,CF,SSQ,NilQ, B, m, SetAlgebra, U, UB, UProducts, USimp, UU, $Basis, $PBWRule,δ,adPower, adExp},
"."];
Begin["`Private`"];

Utilities

(Subscript[δ, i_,j_]):=If[i==j,1,0];

SSQ[c_.*x_]/;MemberQ[$Basis,x]:=¬NilQ[x];  (* Semi-Simple Q *)
NilQ[c_*x_]/;MemberQ[$Basis,x]:=NilQ[x];
SSQ[x_Plus]:=And@@(SSQ/@(List@@x));
NilQ[x_Plus]:=And@@(NilQ/@(List@@x));

$k=1;

CF[ℰ_]:=Expand[ℰ/.(E^(L_)):>(E^(Expand[L]))]/.{(ϵ^(k_.))/;k>$k->0};

Implementing general universal enveloping algebras

B[0,_]=0; B[_,0]=0;
B[c_*x_,y_]/; MemberQ[$Basis,x]:=CF[c B[x,y]];
B[y_,c_*x_]/; MemberQ[$Basis,x]:=CF[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_] := CF[-B[x,y]];

x_⪯y_:=OrderedQ[{x,y}/.$PBWRule]; x_≺y_:=!OrderedQ[{y,x}/.$PBWRule];
(Subscript[UU, i_])[1] := (Subscript[U, i])[];
(Subscript[UU, i_])[((x_)^(p_))]:=(Subscript[UU, i])@@Table[x,{p}];
(Subscript[UU, i_])[ℰ_] := ℰ /. {
U[xs__] :> (Subscript[U, i])[xs],
x_ /; MemberQ[$Basis,x]:>(Subscript[U, i])[x]
};
(Subscript[UU, i_])[x_,xs__] := (Subscript[UU, t1])[x](Subscript[UU, t2])[xs] // Expand // (Subscript[m, t1,t2->i]);
USimp[ℰ_]:= Collect[ℰ, Times[(Subscript[U, _])[__]..], Expand];
USimp[ℰ_]:=Expand[ℰ];

(Subscript[m, s__])[0]=0;
(Subscript[m, s__])[x_Plus] := (Subscript[m, s])/@x;
(Subscript[m, s__])[sd_SeriesData] := MapAt[(Subscript[m, s]), sd, {3,All}];
(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]}];

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

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[x_] := x;
x_**y_ := Module[{is=Supp[x]⋂Supp[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];

Epilog

End[]; EndPackage[];

Predefined Algebras

sl(2)

Print["UEA`SetAlgebra knows \"sl2\"."];

SetAlgebra["sl2"] := (
Print["In sl2: ⟨e,h,f⟩/([h,e]=2e, [h,f]=-2f, [e,f]=h)."];
B[h,e]=2e; B[h,f]=-2f; B[e,f]=h;
$Algebra="sl2";
$Basis={e,h,f};
$PBWRule = {e->1,h->2,f->3};
NilQ[e]=NilQ[f]=True; NilQ[h]=False;
);

(Subscript[gl, n,ϵ])

Print["UEA`SetAlgebra knows the ϵ-nilpotent algebra \!(Subscript[gl, n,ϵ])."];

SetAlgebra[(Subscript[gl, n_,ϵ])] := (
$Algebra=(Subscript[gl, n,ϵ]);
$Basis=Flatten@{
Table[(Subscript[y, α,β]),{β,2,n},{α,1,β-1}],
Table[(Subscript[x, α,β]),{β,1,n},{α,1,β}]
};
(*$Basis=Reverse@SortBy[$Basis,If[#[[1]]===x,{0,#[[3]]-#[[2]]}, {1,#[[2]]-#[[3]]}]&];*)
NilQ[(Subscript[y, __])]=True; NilQ[(Subscript[x, α_,β_])]:=(α=!=β); (* Nilpotent Q *)
$PBWRule = Thread[$Basis->Range@Length@$Basis];
B[(Subscript[x, i_,j_]),(Subscript[x, k_,l_])]:=(Subscript[δ, j,k])(Subscript[x, i,l])-(Subscript[δ, l,i])(Subscript[x, k,j]);
B[(Subscript[y, i_,j_]),(Subscript[y, k_,l_])]:=CF[-ϵ (Subscript[δ, j,k])(Subscript[y, i,l])+ϵ (Subscript[δ, l,i])(Subscript[y, k,j])];
B[(Subscript[x, i_,j_]),(Subscript[y, l_,k_])]:=CF[(Subscript[δ, j,k])(Subscript[x, i,l])-(Subscript[δ, l,i])(Subscript[x, k,j])/.(Subscript[x, α_,β_]):>If[α<=β,ϵ (Subscript[x, α,β]),(Subscript[y, β,α])]];
DefRep[0]=Normal@SparseArray[{},{n,n}];
DefRep[ℰ_]:=ℰ/.{
(Subscript[x, α_,β_]):>Normal@SparseArray[{α,β}->1,{n,n}],
(Subscript[y, α_,β_]):>Normal@SparseArray[{β,α}->ϵ,{n,n}]
}
);

adPower[x_,k_,Env_][c_*y_]/; MemberQ[$Basis,y]:=CF[c adPower[x,k,Env][y]];
adPower[x_,k_,Env_][y_Plus] := adPower[x,k,Env]/@ y;
adPower[_,0,Env_][y_]:=y;
adPower[x_,k_,Env_][0]=0;
adPower[x_,k_,Env_][y_]/;MemberQ[$Basis,y]:=adPower[x,k,Env][y]=B[adPower[x,k-1,Env][y],x];
adPower[x_,k_][y_]:=adPower[x,k,{$Algebra,$k}][y];

adExp[x_][y_]/;SSQ[x]:=Expand@Module[{A,b,c},
A=Table[Coefficient[B[b,x],c],{c,$Basis},{b,$Basis}];
CF[$Basis.Normal[Series[MatrixExp[A],{ϵ,0,$k}]].Table[Coefficient[y,b],{b,$Basis}]]
]

adExp[x_][y_]/;NilQ[x]:=Expand@Module[{k=0,s=0},
While[adPower[x,k][y]=!=0,
s+=adPower[x,k][y]/k!;
++k
];
s
]

λTangent[]=0;
λTangent[xs___,x_]:=adExp[x][λTangent[xs]]+(∂_λ)x;
λTangent[xs_List]:=λTangent@@xs

TriangularDSolve[eqns_,funs_,iv_]:=Module[{sol={},e,fun,der},
MapThread[
{e,fun}|->sol=Join[sol,
Echo@MapAt[CF,First@DSolve[Echo@CF[e/.Derivative[1][f_][v_]:>der[f[v],v]/.sol/.der[f_,v_]:>(∂_v)f],fun,iv],{1,2}]
],
{eqns,funs}
];
sol
]

(Subscript[gl, 2,ϵ]) Experiments

SetAlgebra[(Subscript[gl, 2,ϵ])];
$PBWRule
MatrixForm@Table[{b1,b2}->B[b1,b2],{b1,$Basis},{b2,$Basis}]
MatrixForm@Table[{b1,b2}->(DefRep[b1].DefRep[b2]-DefRep[b2].DefRep[b1]==DefRep[B[b1,b2]]),{b1,$Basis},{b2,$Basis}]

DeleteCases[Flatten[Table[{a,b,c}->B[a,B[b,c]]+B[b,B[c,a]]+B[c,B[a,b]],{a,$Basis},{b,$Basis},{c,$Basis}]], _->0]

lhs=λTangent[Join[
Table[If[SSQ[b1],(b1/.x->ξ1)b1, λ(b1/.{x->ξ1,y->η1})b1],{b1,$Basis}],
Table[If[SSQ[b2],(b2/.x->ξ2)b2, λ(b2/.{x->ξ2,y->η2})b2],{b2,$Basis}]
]]

rhs=λTangent[
Table[If[SSQ[b],b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α])+ϵ (Subscript[f, α,α])[λ])(Subscript[x, α,α]),(b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]})b],{b,$Basis}]
]

eqns=Simplify[(Coefficient[lhs-rhs,#]==0)&/@$Basis]

Length@eqns

unknowns=$Basis/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]}

{sol0}=Block[{$k=0},Simplify@DSolve[
And@@Join[
CF/@eqns,
Select[$Basis,NilQ]/.{(Subscript[x, αβ__]):>(Subscript[f, αβ])[0]==0,(Subscript[y, αβ__]):>(Subscript[g, αβ])[0]==0}
],
Select[$Basis,NilQ]/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]},
λ
]]

{sol1}=Block[{$k=1},Simplify@DSolve[
lhs=λTangent[Join[
Table[If[SSQ[b1],(b1/.x->ξ1)b1, λ(b1/.{x->ξ1,y->η1})b1],{b1,$Basis}],
Table[If[SSQ[b2],(b2/.x->ξ2)b2, λ(b2/.{x->ξ2,y->η2})b2],{b2,$Basis}]
]];
rhs=λTangent[
Table[If[SSQ[b],
b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α])+ϵ (Subscript[f, α,α])[λ])(Subscript[x, α,α]),
(b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]})b /.(sol0/.((a_->b_):>(a->ϵ a+b)))
],{b,$Basis}]
];
Join[
(Coefficient[CF[lhs-rhs],#]==0)&/@$Basis,
$Basis/.{(Subscript[x, αβ__]):>(Subscript[f, αβ])[0]==0,(Subscript[y, αβ__]):>(Subscript[g, αβ])[0]==0}
],
$Basis/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]},
λ
]]

cm[i_,j_->k_]:=(Subscript[𝔼, {i,j}->{k}])[CF@Sum[If[SSQ[b],
b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α]))(Subscript[x, α,α])[k],
b[k](b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]}/.sol0),
],{b,$Basis}],
CF@Sum[b[k](b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]}/.sol1),{b,$Basis}]
]/.{(Subscript[ξ1, αβ__]):>(Subscript[ξ, αβ])[i],(Subscript[η1, αβ__]):>(Subscript[η, αβ])[i],(Subscript[ξ2, αβ__]):>(Subscript[ξ, αβ])[j],(Subscript[η2, αβ__]):>(Subscript[η, αβ])[j],λ->1};
cm[i,j->k]

cm[1,2->2]//cm[2,3->1]

Simplify[(cm[1,2->2]//cm[2,3->1])≡(cm[2,3->2]//cm[1,2->1])]

(Subscript[gl, 3,ϵ]) Experiments

SetAlgebra[(Subscript[gl, 3,ϵ])];
$k=1
$PBWRule
MatrixForm@Table[{b1,b2}->B[b1,b2],{b1,$Basis},{b2,$Basis}]
MatrixForm@Table[{b1,b2}->(DefRep[b1].DefRep[b2]-DefRep[b2].DefRep[b1]==DefRep[B[b1,b2]]),{b1,$Basis},{b2,$Basis}]

DeleteCases[Flatten[Table[{a,b,c}->B[a,B[b,c]]+B[b,B[c,a]]+B[c,B[a,b]],{a,$Basis},{b,$Basis},{c,$Basis}]], _->0]

{sol0}=Block[{$k=0},
lhs=λTangent[Join[
Table[If[SSQ[b1],(b1/.x->ξ1)b1, λ(b1/.{x->ξ1,y->η1})b1],{b1,$Basis}],
Table[If[SSQ[b2],(b2/.x->ξ2)b2, λ(b2/.{x->ξ2,y->η2})b2],{b2,$Basis}]
]];
rhs=λTangent[
Table[If[SSQ[b],b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α])+ϵ (Subscript[f, α,α])[λ])(Subscript[x, α,α]),(b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]})b],{b,$Basis}]
];
Simplify@DSolve[
And@@Join[
(Coefficient[CF[lhs-rhs],#]==0)&/@$Basis,
Select[$Basis,NilQ]/.{(Subscript[x, αβ__]):>(Subscript[f, αβ])[0]==0,(Subscript[y, αβ__]):>(Subscript[g, αβ])[0]==0}
],
Select[$Basis,NilQ]/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]},
λ
]]

$k=1; SBasis=SortBy[$Basis,If[#[[1]]===x,{0,#[[3]]-#[[2]]}, {1,#[[2]]-#[[3]]}]&];
lhs=λTangent[Join[
Table[If[SSQ[b1],(b1/.x->ξ1)b1, λ(b1/.{x->ξ1,y->η1})b1],{b1,$Basis}],
Table[If[SSQ[b2],(b2/.x->ξ2)b2, λ(b2/.{x->ξ2,y->η2})b2],{b2,$Basis}]
]];
rhs=λTangent[
Echo@Table[If[SSQ[b],
b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α])+ϵ (Subscript[f, α,α])[λ])(Subscript[x, α,α]),
(b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]})b /.(sol0/.((v_->s_):>(v->ϵ v+s)))
],{b,$Basis}]
];
eqns=Transpose@{
(Coefficient[CF[lhs-rhs],#]==0)&/@SBasis,
SBasis/.{(Subscript[x, αβ__]):>(Subscript[f, αβ])[0]==0,(Subscript[y, αβ__]):>(Subscript[g, αβ])[0]==0}
};
unknowns=SBasis/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]};
(*{sol1}=DSolve[Flatten@eqns,unknowns,λ]*)
sol1=TriangularDSolve[eqns,unknowns,λ];

Sort@sol1

cm[i_,j_->k_]:=(Subscript[𝔼, {i,j}->{k}])[CF@Sum[If[SSQ[b],
b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α]))(Subscript[x, α,α])[k],
b[k](b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]}/.sol0)
],{b,$Basis}],
CF@Sum[b[k](b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]}/.sol1),{b,$Basis}]
]/.{(Subscript[ξ1, αβ__]):>(Subscript[ξ, αβ])[i],(Subscript[η1, αβ__]):>(Subscript[η, αβ])[i],(Subscript[ξ2, αβ__]):>(Subscript[ξ, αβ])[j],(Subscript[η2, αβ__]):>(Subscript[η, αβ])[j],λ->1};
cm[i,j->k]

Short[cm[1,2->2]//cm[2,3->1],10]

Simplify[(cm[1,2->2]//cm[2,3->1])≡(cm[2,3->2]//cm[1,2->1])]

osol=(Subscript[𝔼, {i,j}->{k}])[(Subscript[y, 1,2])[k] (Subscript[η, 1,2])[i]+(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j]+(Subscript[y, 1,3])[k] (Subscript[η, 1,3])[i]+(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,3])[j]+(Subscript[y, 2,3])[k] (Subscript[η, 2,3])[i]+(E^(-(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (Subscript[η, 2,3])[j]+(Subscript[x, 1,1])[k] (Subscript[ξ, 1,1])[i]+(Subscript[x, 1,1])[k] (Subscript[ξ, 1,1])[j]+(E^(-(Subscript[ξ, 1,1])[j])) (Subscript[x, 1,2])[k] (Subscript[ξ, 1,2])[i]-(E^((Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i]+(E^(-(Subscript[ξ, 2,2])[i])) (Subscript[x, 1,2])[k] (Subscript[ξ, 1,2])[j]+(E^(-(Subscript[ξ, 1,1])[j])) (Subscript[x, 1,3])[k] (Subscript[ξ, 1,3])[i]+(E^(-(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,3])[k] (Subscript[ξ, 1,3])[j]+(Subscript[x, 2,2])[k] (Subscript[ξ, 2,2])[i]+(Subscript[x, 2,2])[k] (Subscript[ξ, 2,2])[j]+(E^(-(Subscript[ξ, 2,2])[j])) (Subscript[x, 2,3])[k] (Subscript[ξ, 2,3])[i]+(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 2,3])[i]-(Subscript[x, 1,3])[k] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 2,3])[i]+(E^(-(Subscript[ξ, 3,3])[i])) (Subscript[x, 2,3])[k] (Subscript[ξ, 2,3])[j]+(Subscript[x, 3,3])[k] (Subscript[ξ, 3,3])[i]+(Subscript[x, 3,3])[k] (Subscript[ξ, 3,3])[j],-(E^(-(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,2])[i] (Subscript[η, 2,3])[j]+(E^((Subscript[ξ, 2,2])[i])) (Subscript[x, 1,1])[k] (Subscript[η, 1,2])[j] (Subscript[ξ, 1,2])[i]-(E^((Subscript[ξ, 2,2])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 1,2])[j] (Subscript[ξ, 1,2])[i]-(E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,2])[j])^2) (Subscript[ξ, 1,2])[i]+(E^((Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,2])[i] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i]+(Subscript[x, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,2])[j]-(E^(-(Subscript[ξ, 2,2])[j])) (Subscript[x, 2,3])[k] (Subscript[η, 1,2])[j] (Subscript[ξ, 1,3])[i]+(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,3])[i]-(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 3,3])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,3])[i]-(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,3])[i]-(E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,3])[i]+(E^(-(Subscript[ξ, 1,1])[j]-(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i]-(E^(-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i]-(E^(-(Subscript[ξ, 1,1])[j]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i]+(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i]+(Subscript[x, 1,3])[k] (Subscript[η, 1,2])[j] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 1,3])[i]+(Subscript[x, 1,3])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 1,3])[j]+(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 2,3])[j] (Subscript[ξ, 2,3])[i]-(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 3,3])[k] (Subscript[η, 2,3])[j] (Subscript[ξ, 2,3])[i]+(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 2,3])[i]-(E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 2,3])[i]-(E^(-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (((Subscript[η, 2,3])[j])^2) (Subscript[ξ, 2,3])[i]+(E^((Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]-(E^((Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]-2 (E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]+(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]-(E^(-(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 2,3])[i]+(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 2,3])[i]-(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+(Subscript[x, 1,3])[k] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[j] (Subscript[ξ, 2,3])[i]-(E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (((Subscript[ξ, 2,3])[i])^2)+(Subscript[x, 2,3])[k] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[j]+(Subscript[x, 2,3])[k] (Subscript[η, 2,3])[j] (Subscript[ξ, 2,3])[i] (Subscript[ξ, 2,3])[j],-(1/2) (E^(2 (Subscript[ξ, 2,2])[i])) (Subscript[x, 1,1])[k] (((Subscript[η, 1,2])[j])^2) (((Subscript[ξ, 1,2])[i])^2)+(1/2) (E^(2 (Subscript[ξ, 2,2])[i])) (Subscript[x, 2,2])[k] (((Subscript[η, 1,2])[j])^2) (((Subscript[ξ, 1,2])[i])^2)+(E^(-(Subscript[ξ, 1,1])[i]+3 (Subscript[ξ, 2,2])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,2])[j])^3) (((Subscript[ξ, 1,2])[i])^2)+(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (Subscript[η, 1,2])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i]-(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i]-(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,2])[j])^2) (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i]+(E^(-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,2])[i] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i]-(E^((Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i]+(E^((Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i]+2 (E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,2])[j])^2) (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i]-(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,2])[i] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i]+(E^(-(Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 1,3])[i]-(E^((Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 1,3])[i]-(1/2) (E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (((Subscript[η, 1,3])[j])^2) (((Subscript[ξ, 1,3])[i])^2)+(1/2) (E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 3,3])[k] (((Subscript[η, 1,3])[j])^2) (((Subscript[ξ, 1,3])[i])^2)+(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (((Subscript[η, 1,3])[j])^2) (((Subscript[ξ, 1,3])[i])^2)+(E^(-(Subscript[ξ, 1,1])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (((Subscript[η, 1,3])[j])^3) (((Subscript[ξ, 1,3])[i])^2)-(E^(-(Subscript[ξ, 1,1])[j]-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (((Subscript[ξ, 1,3])[i])^2)+(E^(-(Subscript[ξ, 2,2])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[η, 2,3])[j] (((Subscript[ξ, 1,3])[i])^2)+(E^(-(Subscript[ξ, 1,1])[j]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (((Subscript[ξ, 1,3])[i])^2)-(E^(3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (((Subscript[η, 1,3])[j])^3) (Subscript[ξ, 1,2])[i] (((Subscript[ξ, 1,3])[i])^2)+(E^(-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,2])[i] (((Subscript[η, 2,3])[j])^2) (Subscript[ξ, 2,3])[i]+(E^((Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (Subscript[η, 1,2])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]-(E^((Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]-2 (E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,2])[j])^2) (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]-(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,2])[i] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 2,3])[i]-(E^(2 (Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (((Subscript[ξ, 1,2])[i])^2) (Subscript[ξ, 2,3])[i]+(E^(2 (Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (((Subscript[ξ, 1,2])[i])^2) (Subscript[ξ, 2,3])[i]+3 (E^(-(Subscript[ξ, 1,1])[i]+3 (Subscript[ξ, 2,2])[i]+(Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,2])[j])^2) (Subscript[η, 1,3])[j] (((Subscript[ξ, 1,2])[i])^2) (Subscript[ξ, 2,3])[i]-(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 3,3])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]-2 (E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+2 (E^(-(Subscript[ξ, 1,1])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[η, 2,3])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]-(E^(-(Subscript[ξ, 1,1])[j]-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (((Subscript[η, 2,3])[j])^2) (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+2 (E^(-(Subscript[ξ, 2,2])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (Subscript[η, 1,3])[j] (((Subscript[η, 2,3])[j])^2) (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]-(E^((Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+(E^((Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+4 (E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+(E^(-(Subscript[ξ, 1,1])[j]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]-2 (E^(3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+(E^(-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]-(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (((Subscript[η, 1,3])[j])^2) (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,2])[j] (Subscript[ξ, 1,3])[i] (Subscript[ξ, 2,3])[i]+(E^(-(Subscript[ξ, 1,1])[i]+(Subscript[ξ, 2,2])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,3])[j])^3) (((Subscript[ξ, 1,3])[i])^2) (Subscript[ξ, 2,3])[i]-(1/2) (E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (((Subscript[η, 2,3])[j])^2) (((Subscript[ξ, 2,3])[i])^2)+(1/2) (E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 3,3])[k] (((Subscript[η, 2,3])[j])^2) (((Subscript[ξ, 2,3])[i])^2)+(E^(-(Subscript[ξ, 1,1])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,3])[k] (Subscript[η, 1,3])[j] (((Subscript[η, 2,3])[j])^2) (((Subscript[ξ, 2,3])[i])^2)+(E^(-(Subscript[ξ, 2,2])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (((Subscript[η, 2,3])[j])^3) (((Subscript[ξ, 2,3])[i])^2)-2 (E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (((Subscript[ξ, 2,3])[i])^2)-(E^(3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 2,3])[k] (Subscript[η, 1,3])[j] (((Subscript[η, 2,3])[j])^2) (Subscript[ξ, 1,2])[i] (((Subscript[ξ, 2,3])[i])^2)-(1/2) (E^(2 (Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,1])[k] (((Subscript[η, 1,3])[j])^2) (((Subscript[ξ, 1,2])[i])^2) (((Subscript[ξ, 2,3])[i])^2)+(1/2) (E^(2 (Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 2,2])[k] (((Subscript[η, 1,3])[j])^2) (((Subscript[ξ, 1,2])[i])^2) (((Subscript[ξ, 2,3])[i])^2)+3 (E^(-(Subscript[ξ, 1,1])[i]+3 (Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (Subscript[η, 1,2])[j] (((Subscript[η, 1,3])[j])^2) (((Subscript[ξ, 1,2])[i])^2) (((Subscript[ξ, 2,3])[i])^2)+(E^(-(Subscript[ξ, 2,2])[i]+2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (((Subscript[η, 2,3])[j])^2) (Subscript[ξ, 1,2])[j] (((Subscript[ξ, 2,3])[i])^2)-(E^(2 (Subscript[ξ, 3,3])[i])) (Subscript[x, 1,2])[k] (Subscript[η, 1,3])[j] (Subscript[η, 2,3])[j] (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,2])[j] (((Subscript[ξ, 2,3])[i])^2)+2 (E^(-(Subscript[ξ, 1,1])[i]+2 (Subscript[ξ, 2,2])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,3])[j])^3) (Subscript[ξ, 1,2])[i] (Subscript[ξ, 1,3])[i] (((Subscript[ξ, 2,3])[i])^2)+(E^(-(Subscript[ξ, 1,1])[i]+3 (Subscript[ξ, 2,2])[i]+3 (Subscript[ξ, 3,3])[i])) (Subscript[y, 1,2])[k] (((Subscript[η, 1,3])[j])^3) (((Subscript[ξ, 1,2])[i])^2) (((Subscript[ξ, 2,3])[i])^3)];
osol=(List@@osol).Table[(ϵ^k),{k,0,Length[osol]-1}]

sol0

CF[sol1/.λ->1]

Coefficient[osol,(Subscript[x, 1,1])[k]ϵ]

CF[(Expand@sol[$k].$Basis/.{(Subscript[ξ1, αβ__]):>(Subscript[ξ, αβ])[i],(Subscript[η1, αβ__]):>(Subscript[η, αβ])[i],(Subscript[ξ2, αβ__]):>(Subscript[ξ, αβ])[j],(Subscript[η2, αβ__]):>(Subscript[η, αβ])[j],λ->1})-(osol/.v_[k]:>v)]

(Subscript[gl, 4,ϵ]) Experiments

SetAlgebra[(Subscript[gl, 4,ϵ])];
$k=1
$PBWRule
MatrixForm@Table[{b1,b2}->B[b1,b2],{b1,$Basis},{b2,$Basis}]
MatrixForm@Table[{b1,b2}->(DefRep[b1].DefRep[b2]-DefRep[b2].DefRep[b1]==DefRep[B[b1,b2]]),{b1,$Basis},{b2,$Basis}]
DeleteCases[Flatten[Table[{a,b,c}->B[a,B[b,c]]+B[b,B[c,a]]+B[c,B[a,b]],{a,$Basis},{b,$Basis},{c,$Basis}]], _->0]

{sol0}=Block[{$k=0},
lhs=λTangent[Join[
Table[If[SSQ[b1],(b1/.x->ξ1)b1, λ(b1/.{x->ξ1,y->η1})b1],{b1,$Basis}],
Table[If[SSQ[b2],(b2/.x->ξ2)b2, λ(b2/.{x->ξ2,y->η2})b2],{b2,$Basis}]
]];
rhs=λTangent[
Table[If[SSQ[b],b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α])+ϵ (Subscript[f, α,α])[λ])(Subscript[x, α,α]),(b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]})b],{b,$Basis}]
];
Simplify@DSolve[
And@@Join[
(Coefficient[CF[lhs-rhs],#]==0)&/@$Basis,
Select[$Basis,NilQ]/.{(Subscript[x, αβ__]):>(Subscript[f, αβ])[0]==0,(Subscript[y, αβ__]):>(Subscript[g, αβ])[0]==0}
],
Select[$Basis,NilQ]/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]},
λ
]]

$k=1; SBasis=SortBy[$Basis,If[#[[1]]===x,{0,#[[3]]-#[[2]]}, {1,#[[2]]-#[[3]]}]&];
lhs=λTangent[Join[
Table[If[SSQ[b1],(b1/.x->ξ1)b1, λ(b1/.{x->ξ1,y->η1})b1],{b1,$Basis}],
Table[If[SSQ[b2],(b2/.x->ξ2)b2, λ(b2/.{x->ξ2,y->η2})b2],{b2,$Basis}]
]];
rhs=λTangent[
Echo@Table[If[SSQ[b],
b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α])+ϵ (Subscript[f, α,α])[λ])(Subscript[x, α,α]),
(b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]})b /.(sol0/.((v_->s_):>(v->ϵ v+s)))
],{b,$Basis}]
];
eqns=Transpose@{
(Coefficient[CF[lhs-rhs],#]==0)&/@SBasis,
SBasis/.{(Subscript[x, αβ__]):>(Subscript[f, αβ])[0]==0,(Subscript[y, αβ__]):>(Subscript[g, αβ])[0]==0}
};
unknowns=SBasis/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]};
(*{sol1}=DSolve[Flatten@eqns,unknowns,λ]*)
sol1=TriangularDSolve[eqns,unknowns,λ];

cm[i_,j_->k_]:=(Subscript[𝔼, {i,j}->{k}])[CF@Sum[If[SSQ[b],
b/.(Subscript[x, α_,α_]):>((Subscript[ξ1, α,α])+(Subscript[ξ2, α,α]))(Subscript[x, α,α])[k],
b[k](b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]}/.sol0)
],{b,$Basis}],
CF@Sum[b[k](b/.{(Subscript[x, αβ__])->(Subscript[f, αβ])[λ],(Subscript[y, αβ__])->(Subscript[g, αβ])[λ]}/.sol1),{b,$Basis}]
]/.{(Subscript[ξ1, αβ__]):>(Subscript[ξ, αβ])[i],(Subscript[η1, αβ__]):>(Subscript[η, αβ])[i],(Subscript[ξ2, αβ__]):>(Subscript[ξ, αβ])[j],(Subscript[η2, αβ__]):>(Subscript[η, αβ])[j],λ->1};
Short[cm[i,j->k],10]

Short[cm[1,2->2]//cm[2,3->1],10]

(cm[1,2->2]//cm[2,3->1])≡(cm[2,3->2]//cm[1,2->1])