Pensieve Header: Solving the two F equations with perturbative hair, where F is written as an exponential.

Ouch! Incorrect F21.

$CutoffDegree=8;
H[h_] := PH[(h /. x[i_] :> z*x[i])+O[z]^$CutoffDegree];

f1coeffs=DeclareSeries[f1[x[1], x[2]], $CutoffDegree-2];
f2coeffs=DeclareSeries[f2[x[1], x[2]], $CutoffDegree-2];
PH[f1]

F=S[Exp[a1 Ar[2,1]+a2 Ar[1,2]+Y[1,2,1,PH[f1]]+Y[1,2,2,PH[f2]]]];
F21 = S[Exp[a1 Ar[1,2]+a2 Ar[2,1]+Y[2,1,2,PH[f1]]+Y[2,1,1,PH[f2]]]];

Short[lhs = Ar[3,0] // S[Exp[Ar[1,3]+Ar[2,3]]] // F]

Short[rhs = Ar[3,0] // F // S[sigma[1,3],sigma[2,3]]]

sol=First[PHSolve[
Coefficient[lhs, Y[1,2,0]] == Coefficient[rhs, Y[1,2,0]],
Join[{a1,a2}, f1coeffs, f2coeffs]
]]

PH[f1] /. sol

CanonicalForm[S[Exp[Ar[1,3]+Ar[2,3]]]**F == F ** S[sigma[1,3],sigma[2,3]] /. sol]

S[Exp[1/2 Ar[1,1]]]

Cases[
lhs2=F21**S[sigma[1,2]]**S[Exp[1/2 Ar[1,1]]]**S[Exp[1/2 Ar[2,2]]],
Y[ijk__, h_] :> Y[ijk],
Infinity
]

Cases[
rhs2= S[Exp[Expand[1/2(Ar[1,1]+Ar[1,2]+Ar[2,1]+Ar[2,2])]]]**F,
Y[ijk__, h_] :> Y[ijk],
Infinity
]

sol2=First[PHSolve[
{
Coefficient[lhs, Y[1,2,0]] == Coefficient[rhs, Y[1,2,0]],
Coefficient[Ar[1,0] // lhs2, Y[1,2,0]] == Coefficient[Ar[1,0] // rhs2, Y[1,2,0]]
},
Join[{a1,a2}, f1coeffs, f2coeffs]
]]

CanonicalForm[
F21**S[sigma[1,2]]**S[Exp[1/2 Ar[1,1]]]**S[Exp[1/2 Ar[2,2]]] == S[Exp[Expand[1/2(Ar[1,1]+Ar[1,2]+Ar[2,1]+Ar[2,2])]]]**F /. sol2
]

Simplify[
{
Coefficient[lhs, Y[1,2,0]] == Coefficient[rhs, Y[1,2,0]],
Coefficient[Ar[1,0] // lhs2, Y[1,2,0]] == Coefficient[Ar[1,0] // rhs2, Y[1,2,0]]
} /. {a1->-(1/2)+a2}
]