Pensieve header: Solving the WKO equations using free-Lie μ-calculus technology; continues pensieve://2013-05/.

Solving the Equations

SetDirectory["C:\\drorbn\\AcademicPensieve\\2013-10"];
<< "../2013-05/FreeLie.m"
$SeriesShowDegree=3; $SeriesCompareDegree = 5;
<< "../2013-05/muCalculus.m"

μCoefficients[expr_] := Flatten[Last[Reap[Collect[expr, _LW|_CW, Sow[#]&]]]];
μCoefficients[l_List] := μCoefficients /@ l;

α=MakeLieSeries[{"1","2"},αs];
β=MakeLieSeries[{"1","2"},βs];
γ=MakeCWSeries[{"1","2"},γs];
V=M[{1->α, 2->β}, γ];
κs[d_, 1] := If[OddQ[d], 0, κs[d]];
κ=MakeCWSeries[{"1"},κs];
Unprotect[C]; C=M[{1->MakeLieSeries[0]}, κ];

HardR4[d_, V_] := Module[{lhs=(SuperPlus[R])[2,3]**(SuperPlus[R])[1,3]**V,rhs = V**((SuperPlus[R])[1,3] // dΔ[1,1,2])},
{lhs[1]@d-rhs[1]@d, lhs[2]@d-rhs[2]@d, lhs[3]@d-rhs[3]@d, lhs[W]@d-rhs[W]@d}
];
TwistEq[d_, V_] := Module[{lhs=V**Θ[1,2],rhs = (SuperPlus[R])[1,2]**(V // dσ[{1,2}->{2,1}])},
{lhs[1]@d-rhs[1]@d, lhs[2]@d-rhs[2]@d, lhs[W]@d-rhs[W]@d}
];
UnitarityEq[d_, V_] := Module[{lhs=V**(V // dA[1] // dA[2]),rhs = dϵ[1]⋃dϵ[2]},
{lhs[1]@d-rhs[1]@d, lhs[2]@d-rhs[2]@d, lhs[W]@d-rhs[W]@d}
];
CapEq[d_, V_, C_] := Module[{lhs=V**(C // dΔ[1,1,2])  // dc[1] // dc[2],rhs = C⋃(C//dσ[1,2])},
{lhs[W]@d-rhs[W]@d}
];
VerticalFlipEq[d_, V_] := Module[{lhs=V**(V // dS[1] // dS[2]),rhs = (SuperPlus[R])[1,2]},
{lhs[1]@d-rhs[1]@d, lhs[2]@d-rhs[2]@d, lhs[W]@d-rhs[W]@d}
];

{V,C}

HardR4[2, V]

HardR4[2, V] // μCoefficients

TwistEq[1, V]// μCoefficients

CapEq[1,V, C]// μCoefficients

VerticalFlipEq[1, V] // μCoefficients

UnitarityEq[1, V]// μCoefficients

Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[2, V], TwistEq[1, V], CapEq[1,V, C], UnitarityEq[1, V]
}]]]

sol1=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[2, V], TwistEq[1, V], CapEq[1,V, C], VerticalFlipEq[1, V]
}]]]

sol1 /. Rule -> Set; {V, C}

UnitarityEq[2, V]

HardR4[3, V] // μCoefficients

TwistEq[2, V]// μCoefficients

CapEq[2,V, C]// μCoefficients

sol2=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[3, V], TwistEq[2, V], UnitarityEq[2, V], CapEq[2,V, C]
}]]]

sol2 /. Rule -> Set; {V, C}

UnitarityEq[3, V] // μCoefficients

HardR4[4, V] // μCoefficients

TwistEq[3, V]// μCoefficients

CapEq[3,V, C]// μCoefficients

sol3=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[4, V], TwistEq[3, V], UnitarityEq[3, V], CapEq[3,V, C]
}]]]

sol3 /. Rule -> Set; {V,C}

UnitarityEq[4, V] // μCoefficients

sol4=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[5, V], TwistEq[4, V], UnitarityEq[4, V], CapEq[4,V, C]
}]]]

sol4 /. Rule -> Set; $SeriesShowDegree=4; {V,C}

VerticalFlipEq[#,V]& /@ {2,3,4}

sol5=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[6, V], TwistEq[5, V], UnitarityEq[5, V], CapEq[5,V, C]
}]]]

sol5 /. Rule -> Set; $SeriesShowDegree=5; {V,C}

VerticalFlipEq[5,V]

sol6=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[7, V], TwistEq[6, V], UnitarityEq[6, V], CapEq[6,V, C]
}]]]

sol6 /. Rule -> Set; $SeriesShowDegree=6; {V,C}

VerticalFlipEq[6,V]

sol7=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[8, V], TwistEq[7, V], UnitarityEq[7, V], CapEq[7,V, C]
}]]]

sol7 /. Rule -> Set; $SeriesShowDegree=7; {V,C}

VerticalFlipEq[7,V]

sol8=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[9, V], TwistEq[8, V], UnitarityEq[8, V], CapEq[8,V, C]
}]]]

βs[8,27]=1; sol8 /. Rule -> Set; $SeriesShowDegree=8; {V,C}

Save["WKOSolution8-1.m", {αs, βs, γs, κs}]

VerticalFlipEq[8,V]

sol9=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[10, V], TwistEq[9, V], UnitarityEq[9, V], CapEq[9,V, C]
}]]]

sol9 /. Rule -> Set; $SeriesShowDegree=9; {V,C}

VerticalFlipEq[9,V]

sol10=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[11, V], TwistEq[10, V], UnitarityEq[10, V], CapEq[10,V, C]
}]]]

βs[10,96]=0; sol10 /. Rule -> Set; $SeriesShowDegree=10; {V,C}

Save["WKOSolution10.m", {αs, βs, γs, κs}]

C

Series[(1/4)Log[(((E^(x/2))-(E^(-x/2)))/x)], {x,0,10}]

TimeUsed[]

VerticalFlipEq[10,V] // Timing

sol11=Solve[(#==0)& /@ Union[μCoefficients[{
HardR4[12, V], TwistEq[11, V], UnitarityEq[11, V], CapEq[11,V, C]
}]]]

sol11 /. Rule -> Set; $SeriesShowDegree=11; {V,C}

C

Save["WKOSolution11.m", {αs, βs, γs, κs}]

VerticalFlipEq[11,V]

TimeUsed[] // Timing