Pensieve header: Exponentiation in  ybax algebras.

Startup

Date[]
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\FullDoPeGDO"];
Once[<<KnotTheory`];
Once[Get@"../Profile/Profile.m"];
BeginProfile[];
$k=2;
<<Engine.m
<<Objects.m
<<KT.m
HL[ℰ_] := Style[ℰ, Background -> If[TrueQ@ℰ,,]];

Exponentials

Task. Define  (Subscript[Exp, m])[U_((Subscript[𝕌, {___}->{i_}])] to compute (e^(𝕆(U))) to order (ϵ^(Length@{U}-1)) using the (Subscript[m, i,i->i]) multiplication, where U is an ϵ-dependent near-docile element, giving the answer in 𝔼-form.
Example: (Subscript[Exp, dm,1])[(Subscript[𝕌, {}->{2}])[(Subscript[b, 2])(Subscript[a, 2])+(Subscript[y, 2])(Subscript[x, 2]),0]] is the exponential of the arrow on strand 2, computed to degree 1.

(Subscript[Exp, m_])[(Subscript[𝕌, is_->{i_}])[U__]]:=Module[{λ,k,n,F,f,j,lhs,rhs,sol,MI(*multi-index*),mis,mi,yax},
MI/:Coefficient[ℰ_,MI[p_,n_,q_]]:=Coefficient[Coefficient[Coefficient[ℰ,(Subscript[y, i]),p],(Subscript[a, i]),n],(Subscript[x, i]),q];
yax/:(yax^(MI[p_,n_,q_])):=(Subscript[y, i]^p)(Subscript[a, i]^n)(Subscript[x, i]^q);
F=(Subscript[𝔼, {}->{i}])[f[λ](Subscript[a, i])];
lhs=((∂_μ)Last[F(F/.{λ->μ,i->j})//(Subscript[m, i,j->i])])/. μ->0/.{f[0]->0, f'[0]->(∂_(Subscript[a, i])){U}[[1]]};
rhs=(∂_λ)Last[F];
F=F/.First@DSolve[lhs==rhs∧f[0]==0, f,λ];
mis={MI[0,0,0],MI[1,0,0],MI[0,0,1],MI[1,0,1]};
F[[1]]+=Sum[(Subscript[f, mi])[λ](yax^mi),{mi,mis}];
lhs=((∂_μ)U2l@Last[F(F/.{λ->μ,i->j})//(Subscript[m, i,j->i])])/. μ->0/.(Subscript[f, _])[0]->0/.Table[(Subscript[f, mi])'[0]->Coefficient[{U}[[1]],mi],{mi,mis}];
rhs=(∂_λ)Last[F];
F=F/.First@DSolve[Table[Coefficient[lhs-rhs,mi]==0∧(Subscript[f, mi])[0]==0, {mi,mis}],Table[(Subscript[f, mi]),{mi,mis}],λ];
Do[
mis=Flatten@Table[MI[p,n,q],{n,0,2k+2,2},{p,0,2k+2-2n},{q,0,2k+2-2n-p}];
AppendTo[F,Sum[(Subscript[f, mi])[λ](yax^mi),{mi,mis}]];
lhs=((∂_μ)U2l@Last[F(F/.{λ->μ,i->j})//(Subscript[m, i,j->i])])/. μ->0/.(Subscript[f, _])[0]->0/.Table[(Subscript[f, mi])'[0]->Coefficient[{U}[[k+1]],mi],{mi,mis}];
rhs=(∂_λ)Last[F];
F=F/.First@DSolve[Table[Coefficient[lhs-rhs,mi]==0∧(Subscript[f, mi])[0]==0, {mi,mis}],Table[(Subscript[f, mi]),{mi,mis}],λ],
{k,Length[{U}]-1}
];
CF@l2U[F/.λ->1]
]

(Subscript[Exp, cm])[(Subscript[𝕌, {}->{i}])[ℏ (Subscript[a, i]) (Subscript[b, i])+ℏ (Subscript[x, i]) (Subscript[y, i]),(Subscript[c, 1])((Subscript[x, i])+(Subscript[y, i]))]]

Step by step

m=cm;U=Sequence[ℏ (Subscript[a, i]) (Subscript[b, i])+ℏ (Subscript[x, i]) (Subscript[y, i]),(Subscript[c, 1])((Subscript[x, i])+(Subscript[y, i])),0]

MI/:Coefficient[ℰ_,MI[p_,n_,q_]]:=Coefficient[Coefficient[Coefficient[ℰ,(Subscript[y, i]),p],(Subscript[a, i]),n],(Subscript[x, i]),q];
yax/:(yax^(MI[p_,n_,q_])):=(Subscript[y, i]^p)(Subscript[a, i]^n)(Subscript[x, i]^q);
F=(Subscript[𝔼, {}->{i}])[f[λ](Subscript[a, i])]

lhs=((∂_μ)Last[F(F/.{λ->μ,i->j})//(Subscript[m, i,j->i])])/. μ->0/.{f[0]->0, f'[0]->(∂_(Subscript[a, i])){U}[[1]]}

rhs=(∂_λ)Last[F]

F=F/.First@DSolve[lhs==rhs∧f[0]==0, f,λ]

mis={MI[0,0,0],MI[1,0,0],MI[0,0,1],MI[1,0,1]}

F[[1]]+=Sum[(Subscript[f, mi])[λ](yax^mi),{mi,mis}]

lhs=((∂_μ)U2l@Last[F(F/.{λ->μ,i->j})//(Subscript[m, i,j->i])])/. μ->0/.(Subscript[f, _])[0]->0/.Table[(Subscript[f, mi])'[0]->Coefficient[{U}[[1]],mi],{mi,mis}]

rhs=(∂_λ)Last[F]

F=F/.First@DSolve[Table[Coefficient[lhs-rhs,mi]==0∧(Subscript[f, mi])[0]==0, {mi,mis}],Table[(Subscript[f, mi]),{mi,mis}],λ]

{k,Length[{U}]-1}

k=1

mis=Flatten@Table[MI[p,n,q],{n,0,2k+2,2},{p,0,2k+2-2n},{q,0,2k+2-2n-p}]

AppendTo[F,Sum[(Subscript[f, mi])[λ](yax^mi),{mi,mis}]]

lhs=((∂_μ)U2l@Last[F(F/.{λ->μ,i->j})//(Subscript[m, i,j->i])])/. μ->0/.(Subscript[f, _])[0]->0/.Table[(Subscript[f, mi])'[0]->Coefficient[{U}[[k+1]],mi],{mi,mis}]

CF[lhs]

rhs=(∂_λ)Last[F]

F=F/.First@DSolve[Table[Coefficient[lhs-rhs,mi]==0∧(Subscript[f, mi])[0]==0, {mi,mis}],Table[(Subscript[f, mi]),{mi,mis}],λ]

k=2

mis=Flatten@Table[MI[p,n,q],{n,0,2k+2,2},{p,0,2k+2-2n},{q,0,2k+2-2n-p}]

AppendTo[F,Sum[(Subscript[f, mi])[λ](yax^mi),{mi,mis}]]

lhs=((∂_μ)U2l@Last[F(F/.{λ->μ,i->j})//(Subscript[m, i,j->i])])/. μ->0/.(Subscript[f, _])[0]->0/.Table[(Subscript[f, mi])'[0]->Coefficient[{U}[[k+1]],mi],{mi,mis}]

rhs=(∂_λ)Last[F]

F=F/.First@DSolve[Table[Coefficient[lhs-rhs,mi]==0∧(Subscript[f, mi])[0]==0, {mi,mis}],Table[(Subscript[f, mi]),{mi,mis}],λ]

CF@l2U[F/.λ->1]