Pensieve Header:  Trying to remember how FreeLie works....

Preliminaries

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

AllLyndonWords[3,{x,y}]//FullForm

t1=Total[AllLyndonWords[3,{x,y}]]

t2=LS[t1]

t2[6]

t2//FullForm

LieSeries[t1]

LieSeries$13[3]//FullForm

Rs[a_,b_]:= Es[⟨a->LS[0], b->LS[LW@a]⟩, CWS[0]];
α=LS[{x,y}, αs]; β=LS[{x,y}, βs];γ=CWS[{x,y}, γs];
V=Es[⟨x->α, y->β⟩, γ];
κ=CWS[{x}, κs]; Cap=Es[⟨x->LS[0]⟩,κ];
R4Eqn=V**(Rs[x,z] // dΔ[x,x,y]) ≡ Rs[y,z]**Rs[x,z]**V ;UnitarityEqn=(V**(V//dA[x]//dA[y]) ≡ Es[⟨x->LS[0], y->LS[0]⟩,CWS[0]]);
CapEqn=((V**(Cap//dΔ[x,x,y])//dc[x]//dc[y]) ≡ (Cap*(Cap//dσ[x,y])//dc[x]//dc[y]));
βs[x]= 1/2; βs[y]=0;
SeriesSolve[{α, β,γ, κ}, ((ℏ^(-1))R4Eqn) && UnitarityEqn && CapEqn];
{V, κ}

logF=V[[1]]//dσ[{x,y}->{y,x}]
logF@{4}

(Subscript[AWExp, d_])[ℒ_]:=Module[{t=AW[]},
AW[]+Sum[t=Expand[t**ℒ/k]/.a_AW/;Length[a]>d:>0,{k,d}]
]

Testing

d=4

lhs=Sum[(Subscript[AW, 1])@@Table[x,k]/k!,{k,0,d}]//FA[x->x+y]

rhs1=(Subscript[AWExp, d])[Plus@@ι[Ad[x/.logF[[1]]][LW@x]]@{d}]/.AW->(Subscript[AW, 1])

rhs2=(Subscript[AWExp, d])[Plus@@ι[Ad[y/.logF[[2]]][LW@y]]@{d}]/.AW->(Subscript[AW, 2])

rhs=(Expand[rhs1*rhs2]//(Subscript[m, 1,2->1]))/.(Subscript[AW, 1])[w___]/;Length@{w}>d:>0

lhs==rhs