Pensieve header: Exp relative to am, bm, cm, dm.

Follows code in Projects/SL2Portfolio/SL2PortfolioProgram.nb.

Startup

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio2"];
(*Once[<< KnotTheory`];*)
Once[<<"../Profile/Profile.m";];
<<"Engine-Speedy.m";
<<"Objects.m";
$k=3;
HL[ℰ_] := Style[ℰ, Background -> Green];

Exponentials as needed.

Task. Define  (Subscript[Exp, m,i,k])[P] to compute (e^(𝕆(P))) to (ϵ^k) in the using the (Subscript[mm, i,i->i]) multiplication, where P is an ϵ-dependent near-docile element, giving the answer in 𝔼-form.
Methodology. If (Subscript[P, 0]):=(Subscript[P, ϵ=0]) and (e^(λ 𝕆(P)))=𝕆((e^(λ (Subscript[P, 0])))F(λ)), then F(λ=0)=1 and we have:
𝕆((e^(λ (Subscript[P, 0])))((Subscript[P, 0])F(λ)+(∂_λ)F))=𝕆((∂_λ)(e^(λ (Subscript[P, 0])))F(λ))=(∂_λ)𝕆((e^(λ (Subscript[P, 0])))F(λ))=(∂_λ)(e^(λ 𝕆(P)))=(e^(λ 𝕆(P)))𝕆(P)=𝕆((e^(λ (Subscript[P, 0])))F(λ))𝕆(P).
This is a linear ODE for F. Setting inductively (Subscript[F, k])=(Subscript[F, k-1])+(ϵ^k)φ we find that (Subscript[F, 0])=1 and solve for φ.

(* Bug: The first line is valid only if 𝕆((E^(Subscript[P, 0])))==(E^(𝕆((Subscript[P, 0])))). *)
(Subscript[Exp, mm_,i_,0])[P_]:=Module[{LQ=Normal@P /. ϵ->0},
𝔼[LQ/.(Subscript[(x|y), i])->0, LQ/.(Subscript[(b|a|t), i])->0,1] ];

mm=dm; i=1;  P0=(Subscript[b, 1])(Subscript[a, 1])+(Subscript[y, 1]) (Subscript[x, 1]);

G=

$k=0, Example 1

mm=dm; P0=(Subscript[y, i]) (Subscript[x, i]);

𝔼G=(Subscript[𝔼, {}->{0}])[LG[λ](Subscript[b, 0])(Subscript[a, 0]),QG[λ](Subscript[y, 0])(Subscript[x, 0]),1+O[ϵ]]

((Subscript[𝔼, {}->{i}])[0,0,P0+O[ϵ]](Subscript[𝔼, {}->{0}])[LG[λ](Subscript[b, 0])(Subscript[a, 0]),QG[λ](Subscript[y, 0])(Subscript[x, 0]),1+O[ϵ]])//(Subscript[mm, i,0->0])

(Subscript[𝔼, {}->{i}])[0,0,P0+O[ϵ]](Subscript[𝔼, {}->{0}])[0,QG[λ](Subscript[y, 0])(Subscript[x, 0]),1+O[ϵ]]//(Subscript[mm, i,0->0])

(Subscript[𝔼, {}->{0}])[LG[λ](Subscript[b, 0])(Subscript[a, 0]),QG[λ](Subscript[y, 0])(Subscript[x, 0]),(∂_λ)(LG[λ](Subscript[b, 0])(Subscript[a, 0])+QG[λ](Subscript[y, 0])(Subscript[x, 0]))+O[ϵ]]

sol=DSolve[QG'[λ]==(((ℏ+QG[λ]-QG[λ] (Subscript[B, 0])))/ℏ)∧QG[0]==0,QG[λ],λ]

Simplify[QG[λ]/.sol]

$k>0

(Subscript[Exp, mm_,i_,k_])[P_]:=Block[{$k=k},
Module[{P0,λ,φ,F,j,rhs,err=0,pows,at0,atλ},
P0=Normal@P /. ϵ->0;
F=Normal@Last@(Subscript[Exp, mm,i,k-1])[λ P];
(*Unary*)While[
If[err=!=0,
pows=Echo[First/@CoefficientRules[err,{(Subscript[y, i]),(Subscript[b, i]),(Subscript[a, i]),(Subscript[x, i])}]];
F+=Sum[(ϵ^k)(Subscript[φ, js])[λ]Times@@(({(Subscript[y, i]),(Subscript[b, i]),(Subscript[a, i]),(Subscript[x, i])})^js),{js,pows}];
rhs=Normal@Last@(Subscript[mm, i,j->i])[(Subscript[(Subscript[𝔼, {}->{i}])[λ P0/.(Subscript[(x|y), i])->0,λ P0/.(Subscript[(b|a|t), i])->0, F], k])(Subscript[sσ, i->j])@(Subscript[(Subscript[𝔼, {}->{i}])[0,0,P], k])];
err=CF[((∂_λ)F)+P0 F-rhs];
at0=Table[(Subscript[φ, js])[0]==0,{js,pows}];
atλ=(#==0)&/@(pows/.CoefficientRules[err,{(Subscript[y, i]),(Subscript[b, i]),(Subscript[a, i]),(Subscript[x, i])}]);
F=F/. DSolve[And@@(at0⋃atλ),Table[(Subscript[φ, js])[λ],{js,pows}],λ][[1]]
];
rhs=Normal@Last@(Subscript[mm, i,j->i])[(Subscript[(Subscript[𝔼, {}->{i}])[λ P0/.(Subscript[(x|y), i])->0,λ P0/.(Subscript[(b|a|t), i])->0, F], k])(Subscript[sσ, i->j])@(Subscript[(Subscript[𝔼, {}->{i}])[0,0,P], k])];
err=CF[((∂_λ)F)+P0 F-rhs];
err=!=0
];
(Subscript[𝔼, {}->{i}])[P0/.(Subscript[(x|y), i])->0,P0/.(Subscript[(b|a|t), i])->0, F+((O[ϵ])^(k+1))/.λ->1]]
]

(Subscript[Exp, dm,1,2])[ξ((Subscript[x, 1])+ϵ (Subscript[y, 1]))]

(Subscript[dS, 1])[(Subscript[𝔼, {}->{1}])[0,0,#]]&/@{(Subscript[y, 1]),(Subscript[x, 1])}

Timing@{lhs=(Subscript[𝔼, {1}->{1}])[0,(Subscript[ξ, 1])(Subscript[x, 1]),1]//(Subscript[dS, 1]), rhs=(Subscript[Exp, dm,1,$k])[(Subscript[ξ, 1])Last@(Subscript[dS, 1])[(Subscript[𝔼, {}->{1}])[0,0,(Subscript[x, 1])]]] /. {{}->{1}}; HL[lhs≡rhs]}

Timing@{lhs=(Subscript[𝔼, {1}->{1}])[0,(Subscript[η, 1])(Subscript[y, 1]),1]//(Subscript[dS, 1]), rhs=(Subscript[Exp, dm,1,$k])[η Last@(Subscript[dS, 1])[(Subscript[𝔼, {}->{1}])[0,0,(Subscript[y, 1])]]] /. {η->(Subscript[η, 1]),{}->{1}}, HL[lhs≡rhs]}

Timing@{lhs=(Subscript[𝔼, {1}->{1}])[0,(Subscript[ξ, 1])(Subscript[x, 1]),1]//(Subscript[cS, 1]), rhs=(Subscript[Exp, cm,1,$k])[(Subscript[ξ, 1])Last@(Subscript[cS, 1])[(Subscript[𝔼, {}->{1}])[0,0,(Subscript[x, 1])]]] /.  {}->{1}; HL[lhs≡rhs]}

Timing@{lhs=(Subscript[𝔼, {1}->{1}])[0,(Subscript[η, 1])(Subscript[y, 1]),1]//(Subscript[cS, 1]), rhs=(Subscript[Exp, cm,1,$k])[(Subscript[η, 1]) Last@(Subscript[cS, 1])[(Subscript[𝔼, {}->{1}])[0,0,(Subscript[y, 1])]]] /. {}->{1}; HL[lhs≡rhs]}