Pensieve header: A full implementation of $gl_n^\epsilon$.

SetDirectory["C:/drorbn/AcademicPensieve/Projects/glneps"];
Once[
<<"KnotTheory`";
<< "Rot.m";
<< "PolyPlot.m";
]

(*Format[(Subscript[ξ, α_,β_])]:=(Subscript[ξ, α,β]);*)
(Subscript[ξ, 1,2])

utm for “upper triangular multiply”
lcm for “last column multiply”.

(Subscript[utm, 1])[i_,j_,,k_]:=𝔼[i,j,,k][((Subscript[ξ, 1,1])[i]+(Subscript[ξ, 1,1])[j])(Subscript[x, 1,1])[k]];
(Subscript[lcm, n_])[i_,j_,,k_] := 𝔼[i,j,,k][((Subscript[ξ, n,n])[i]+(Subscript[ξ, n,n])[j])(Subscript[x, n,n])[k]+(∑_(ν=1)^(n-1))((((Subscript[Ξ, n,n])[j])^(-1))(Subscript[ξ, ν,n])[i]+(Subscript[ξ, ν,n])[j])(Subscript[x, ν,n])[k]];

(Subscript[lcm, 3])[i,j,,k]

n=5;
ZM=Table[0,n,n];
(Subscript[E, α_,β_]):=ReplacePart[ZM, {α,β}->1];
B=IdentityMatrix[n];
Do[B=B.MatrixExp[(Subscript[ξ, α,α+δα])(Subscript[E, α,α+δα])],{δα,0,n-1},{α,1,n-δα}];
Bi=B/.(Subscript[ξ, αβ__]):>(Subscript[ξ, αβ])[i];
Bj=B/.(Subscript[ξ, αβ__]):>(Subscript[ξ, αβ])[j];
Bk=B/.(Subscript[ξ, αβ__]):>(Subscript[ξ, αβ])[k];
MatrixForm[Bk]
MatrixForm[Simplify[Bi.Bj]]

eqns=And@@Thread[Flatten[Simplify[(Inverse[Bk]/.(Subscript[ξ, α_,α_])[k]:>(Subscript[ξ, α,α])[i]+(Subscript[ξ, α,α])[j]).Bi.Bj]]==Flatten[IdentityMatrix[n]]]

vars=Union@Cases[eqns,(Subscript[ξ, __])[k],∞]

{sol}=Solve[eqns,vars]

Simplify[(vars/.ξ->x).(vars/.sol)]

n=5;
ZM=Table[0,n,n];
(Subscript[E, α_,β_]):=ReplacePart[ZM, {α,β}->1];
B=IdentityMatrix[n];
Do[B=B.MatrixExp[(Subscript[ξ, α,β])(Subscript[E, α,β])],{β,1,n},{α,1,β}];
Bi=B/.(Subscript[ξ, αβ__]):>(Subscript[ξ, αβ])[i];
Bj=B/.(Subscript[ξ, αβ__]):>(Subscript[ξ, αβ])[j];
Bk=B/.(Subscript[ξ, αβ__]):>(Subscript[ξ, αβ])[k];
MatrixForm[Bk]
MatrixForm[Simplify[Bi.Bj]]

eqns=And@@Thread[Flatten[Simplify[(Inverse[Bk]/.(Subscript[ξ, α_,α_])[k]:>(Subscript[ξ, α,α])[i]+(Subscript[ξ, α,α])[j]).Bi.Bj]]==Flatten[IdentityMatrix[n]]]

vars=Union@Cases[eqns,(Subscript[ξ, __])[k],∞]

{sol}=Solve[eqns,vars]

Simplify[(vars/.ξ->x).(vars/.sol)]