Solving linearized 5-gon in emergent 𝒫

SetDirectory["C:\\drorbn\\AcademicPensieve\\People\\Kuno"];
<< FreeLie.m

Extending FreeLie.m

The antipode

Antipode[ℰ_]:=Expand[ℰ/.w_AW:>(((-1))^(Length[w]))Reverse[w]]

The map R

The map R: FL --> FA (symmetric - horizontal)

(Subscript[R, A_])[0]=0;
(Subscript[R, A_])[u_LW]:=(Subscript[R, A])[u]=Module[{w1,w2},
If[Deg[u]===1,0,
{w1,w2}=LyndonFactorization[u];
Expand[
b[ι[w1],(Subscript[R, A])[w2]]+b[(Subscript[R, A])[w1],ι[w2]]
+Sum[(τ[LW[α],w2]**AW[α]**Antipode[τ[LW[α],w1]]-τ[LW[α],w1]**AW[α]**Antipode[τ[LW[α],w2]])/2,
{α,A}]
]
]
];
(Subscript[R, A_])[ℰ_]:=Expand[ℰ/.LW[seq__]:>(Subscript[R, A])[LW[seq]]];
(Subscript[R, A_])[ls_LieSeries] := (Subscript[R, A])[ls] = New[ASeries[as],
as[d_] := as[d] = (Subscript[R, A])[ls[d+1]]
];

(Subscript[R, {x,y}])[LW[x,x,x,y]]

(Subscript[R, {x,y,z}])[b[b[LW[x],LW[y]],b[LW[x],LW[z]]]]

P3[ψ_LieSeries]:=Module[{pd},
pd=τ[LW[y],ψ];
pd + LieMorphism[{LW[x]->LW[y],LW[y]->0}]@pd - LieMorphism[{LW[x]->LW[x]+LW[y],LW[y]->0}]@pd-2(Subscript[R, {x,y}])[ψ]
]

ψ=LS[{LW@x,LW@y}, ψs]

pd=τ[LW[y],ψ]

LieMorphism[{LW[x]->LW[y],LW[y]->LW[x]}][AW[y,x,y]]

LieMorphism[{LW[x]->LW[y],LW[y]->0}]@pd

ψ

P3[ψ]

AS[0]

sol=SeriesSolve[{ψ},ℏ(P3[ψ]≡AS[0])]

ψ@{11}

Read[sol]//Column