Cheat Sheet J - Verification

Pensieve header: Cheat Sheet $J$ Verification; continues pensieve://2013-12/; continued CheatSheetFreeLie-Verification @ pensieve://Projects/WKO4.

SetDirectory["C:\\drorbn\\AcademicPensieve\\2014-01"];
<< FreeLie.m;
IntegrateLieSeries[ls_LieSeries, {s_, s0_, s1_}] := IntegrateLieSeries[ls, {s, s0, s1}] = Module[{ser},
ser=Unique[IntegrateLieSeries];
ser[]=Hold[IntegrateLieSeries[ls, {s, s0, s1}]];
ser[d_Integer] := ser[d] = Expand[Integrate[ls[d], {s,s0,s1}]];
LieSeries[ser]
];
LieSeries /: Integrate[ls_LieSeries, {s_, s0_, s1_}] := IntegrateLieSeries[ls, {s,s0,s1}];

LieMorphism /: Inverse[mor_LieMorphism] := InvertLieMorphism[mor];
InvertLieMorphism[mor_LieMorphism] := InvertLieMorphism[mor] =Module[{uimg},
LieMorphism[Table[
ReleaseHold[Hold[
uimg[]=Hold[Inverse[mor][u]];
uimg[1] = u;
uimg[d_Integer] /; d>1 := uimg[d] = -(∑_(k=1)^(d-1))(mor[uimg[k]][d]);
u -> LieSeries[uimg]
] /. uimg->Unique[InverseLieMorphismOnGenerator]],
{u,mor[Support]}
]]
];

tm[u_,v_,w_] := LieMorphism[⟨u⟩->⟨w⟩, ⟨v⟩->⟨w⟩];
CC[us:{___}, γs:{_LieSeries...}] := LieMorphism[MapThread[Function[{u,γ},u -> Ad[γ][u]],{us,γs}]];
CC[u_, γ_LieSeries] := CC[{u},{γ}];
(Subscript[CC, u_])[γ_] := CC[u,γ];
RC[us:{___}, γs:{_LieSeries...}] := Inverse[CC[us, -γs]];
RC[u_, γ_LieSeries] := RC[{u},{γ}];
(Subscript[RC, u_])[γ_] := RC[u,γ];
ad[us:{___}, γs:{_LieSeries...}] := LieDerivation[MapThread[Function[{u,γ},u -> b[γ,u]],{us,γs}]];
ad[u_, γ_LieSeries] := ad[{u},{γ}];
(Subscript[ad, u_])[γ_] := ad[u,γ];
(* ad[u_, γ_LieSeries] := LieDerivation[u -> b[γ, u]];
(Subscript[ad, u_])[γ_] := ad[u,γ]; *)
ϵ /: (ϵ^2)=0;
Print /@ {{t=⟨"t"⟩, u=⟨"u"⟩, v=⟨"v"⟩, w=⟨"w"⟩},
α = RandomLieSeries[{t,u,v}], δα = RandomLieSeries[{t,u,v}],
β = RandomLieSeries[{t,u,v}], δβ = RandomLieSeries[{t,u,v}],
γ = RandomLieSeries[{t,u,v}], δγ = RandomLieSeries[{t,u,v}]
};
$SeriesShowDegree=3; $SeriesCompareDegree = 6;

Some preliminary testing

(α // (Subscript[RC, u])[γ] // (Subscript[CC, u])[-γ])≡α

(α // (Subscript[RC, u])[γ] // (Subscript[RC, u])[-γ//(Subscript[RC, u])[γ]])≡α

The Definition of J

J[u_, γ_] := J[u,γ] = Module[{s},(∫_0^1)(γ // (Subscript[RC, u])[s γ] // (Subscript[div, u]) // (Subscript[CC, u])[-s γ])\[DifferentialD]s];
(Subscript[J, u_])[γ_] := J[u,γ];

(Subscript[J, u])[α][{4}]

The (Subscript[J, uv]) equation

Print /@ {
0 -> {α, β},
1 -> (t1=(Subscript[J, u])[α]+((Subscript[J, v])[β // (Subscript[RC, u])[α]] // (Subscript[CC, u])[-α])),
2 -> (t2=(Subscript[J, v])[β]+((Subscript[J, u])[α // (Subscript[RC, v])[β]] // (Subscript[CC, v])[-β])),
3->  t1≡t2
};

The t equation

Print /@ {
0 -> γ,
1 -> (t1=J[w, γ // tm[u,v,w]]),
2 -> (t2=(Subscript[J, u])[γ] // tm[u,v,w]),
3 -> (t3=(Subscript[J, v])[γ // (Subscript[RC, u])[γ]] // (Subscript[CC, u])[-γ] // tm[u,v,w]),
4 -> t1≡t2+t3
};

Print /@ {
0 -> {γ, γw =  γ // tm[u,v,w]},
1 -> (t1=J[w, γw] // (Subscript[RC, w])[γw]),
2 -> (t2=(Subscript[J, u])[γ] // tm[u,v,w] // (Subscript[RC, w])[γw]),
3 -> (t3=(Subscript[J, v])[γ // (Subscript[RC, u])[γ]] // (Subscript[RC, v])[γ // (Subscript[RC, u])[γ]] // tm[u,v,w]),
4 -> t1≡t2+t3
};

The h equation

Print /@ {
1 -> (t1=J[u, BCH[α, β]]),
2 -> (t2=J[u,α]),
3 -> (t3=J[u,β//RC[u,α]]//CC[u,-α]),
4 -> t1≡t2+t3
};

h and S

(Plus[
(Subscript[J, u])[γ]//(Subscript[RC, u])[γ],
(Subscript[J, u])[-γ//(Subscript[RC, u])[γ]]
] // (Subscript[RC, u])[-γ//(Subscript[RC, u])[γ]]) @ {6}

The meaning(s) of RC

Print /@ {
1 -> α,
2 -> (t1=α // CC[u, γ] // RC[u, -γ]),
3 -> α≡t1
};

Print /@ {
1 -> α,
2 -> (t1= α // CC[u, γ // RC[u, γ]]),
3 -> (t2= α // RC[u, γ]),
4 -> t1≡t2
};

(Subscript[C, u])(Subscript[C, v]) and (Subscript[RC, u])(Subscript[RC, v])

Print /@ {
1 -> {α, β, γ},
2 -> (t1=γ // (Subscript[CC, u])[α // (Subscript[RC, v])[-β]] // (Subscript[CC, v])[β]),
3 -> (t2=γ // (Subscript[CC, v])[β // (Subscript[RC, u])[-α]] // (Subscript[CC, u])[α]),
4 -> t1≡t2
};

Print /@ {
1 -> {α, β, γ},
2 -> (t1=γ // (Subscript[RC, u])[α] // (Subscript[RC, v])[β // (Subscript[RC, u])[α]]),
3 -> (t2=γ // (Subscript[RC, v])[β] // (Subscript[RC, u])[α // (Subscript[RC, v])[β]]),
4 -> t1≡t2
};

div property uv

Print /@ {
0 -> {α, β},
1 -> (t1=(Subscript[div, u])[α] // (Subscript[ad, v])[β]),
2 -> (t2=(Subscript[div, v])[β] // (Subscript[ad, u])[α]),
3 -> (t3=MakeCWSeries[0]),
4 -> (t4=(Subscript[div, u])[α//(Subscript[ad, v])[β]]),
5 -> (t5=(Subscript[div, v])[β//(Subscript[ad, u])[α]]),
6 -> t1-t2≡t3+t4-t5
};

div property uu

Print /@ {
0 -> {α, β},
1 -> (t1=(Subscript[div, u])[α] // (Subscript[ad, u])[β]),
2 -> (t2=(Subscript[div, u])[β] // (Subscript[ad, u])[α]),
3 -> (t3=(Subscript[div, u])[b[α,β]]),
4 -> (t4=(Subscript[div, u])[α//(Subscript[ad, u])[β]]),
5 -> (t5=(Subscript[div, u])[β//(Subscript[ad, u])[α]]),
6 -> t1-t2≡t3+t4-t5
};

The growth map Γ

Γ[-1, ___] = MakeLieSeries[0];
Γ[n_, u_LW, γ_LieSeries, ss_] := Γ[n,u,γ,ss] = Module[{s, β0},
β0=Γ[n-1,u,γ,s];
(∫_0^ss)(γ // DerivationExp[(Subscript[ad, u])[s γ]] // adSeries[(ad/((E^ad)-1)), β0])\[DifferentialD]s
];
Γ[u_LW, γ_LieSeries, s_] := Γ[u,γ, s] = Module[{ser},
ser=Unique[Γ];
ser[]=Hold[Γ[u,γ]];
ser[d_Integer] := ser[d] = Γ[d-1, u, γ, s][d];
LieSeries[ser]
];
Γ[u_LW, γ_LieSeries] := Γ[u,γ] = Module[{ser,s},
ser=Unique[Γ];
ser[]=Hold[γ[u,γ]];
ser[d_Integer] := ser[d] = Γ[d-1, u, γ, s][d] /. s->1;
LieSeries[ser]
];

Print /@ {
0 -> γ,
1 -> (t1= Γ[u,γ]),
2 -> (t2= β  // DerivationExp[(Subscript[ad, u])[γ]]),
3 -> (t3= β // (Subscript[CC, u])[Γ[u,γ]]),
4 -> t2≡t3
};

The many-variable growth map Γ

Γ[-1, ___] = MakeLieSeries[0];
Γ[n_, u_LW, us_List,γs:{_LieSeries...}, ss_] := Γ[n,u,us,γs,ss] = Module[{s,γ,Γ0},
γ=u /. Thread[us -> γs];
Γ0=Γ[n-1,u,us,γs,s];
(∫_0^ss)(γ // DerivationExp[(∑_(i=1)^(Length[us]))(Subscript[ad, us[[i]]])[s γs[[i]]]] // adSeries[(ad/((E^ad)-1)), Γ0])\[DifferentialD]s
];
Γ[u_LW, us_List, γs:{_LieSeries...}, s_] := Γ[u,us,γs,s] = Module[{ser},
ser=Unique[Γ];
ser[]=Hold[Γ[u,us,γs]];
ser[d_Integer] := ser[d] = Γ[d-1, u, us, γs, s][d];
LieSeries[ser]
];
Γ[u_LW, us_List, γs:{_LieSeries...}] := Γ[u,us, γs] = Module[{ser,s},
ser=Unique[Γ];
ser[]=Hold[γ[u,us, γs]];
ser[d_Integer] := ser[d] = Γ[d-1, u, us, γs, s][d] /. s->1;
LieSeries[ser]
];

Print /@ {
0 -> {α,β,γ},
1 -> (t1= Γ[u,{u,v},{α,β}]),
2 -> (t2= β  // DerivationExp[(Subscript[ad, u])[α]+(Subscript[ad, v])[β]]),
3 -> (t3= β // (Subscript[CC, {u,v}])[{Γ[u,{u,v},{α,β}], Γ[v,{u,v},{α,β}]}]),
4 -> t2≡t3
};

The differential of BCH

Print /@ {
1 -> (bch=BCH[u,v]),
2 -> ((BCH[u+ϵ t, v+ϵ w]-bch)/ϵ),
3 -> (t1=((BCH[u+ϵ t, v+ϵ w]-bch)/ϵ) // adSeries[((1-(E^(-ad)))/ad), bch]),
4 -> (t2=t // adSeries[((1-(E^(-ad)))/ad),u] // Ad[-v]),
5 -> (t3=w // adSeries[((1-(E^(-ad)))/ad),v])
};
t1 ≡ t2+t3

The differential of C

Print /@ {
0 -> {α, δα, γ},
1 -> (t1=(((γ // CC[u, α+ϵ δα]) - (γ // CC[u, α]) )/ϵ)),
2 -> (t2=γ // ad[u, δα // adSeries[(((E^ad)-1)/ad),α] // RC[u, -α]] // CC[u, α]),
t1 ≡ t2
};

The differential of (Subscript[C, u,v])

Print /@ {
0 -> {α,δα,β,δβ,γ},
1 -> (t1=(((γ // (Subscript[CC, {u,v}])[{α+ϵ δα, β+ϵ δβ}]) - (γ // (Subscript[CC, {u,v}])[{α,β}]) )/ϵ)),
2 -> (t2=Plus[
γ // (Subscript[ad, u])[δα // adSeries[(((E^ad)-1)/ad),α] // (Subscript[RC, {u,v}])[{-α, -β}]],
γ // (Subscript[ad, v])[δβ // adSeries[(((E^ad)-1)/ad),β] // (Subscript[RC, {u,v}])[{-α, -β}]]
] // (Subscript[CC, {u,v}])[{α,β}]),
t1 ≡ t2
};

The differential of RC

Print /@ {
0 -> {α, β, γ},
1 -> (t1=(((γ // RC[u, α+ϵ β]) - (γ // RC[u, α]) )/ϵ)),
2 -> (t2=γ // RC[u, α] // ad[u, adSeries[((1-(E^(-ad)))/ad),α][β] // RC[u, α]]),
t1 ≡ t2
};

The differential of J

Print /@ {
0 -> {α, β};
1 -> (t0=((J[u,α+ϵ β]-J[u,α])/ϵ)),
2 -> (t1=div[u, β//adSeries[((1-(E^(-ad)))/ad), α]//RC[u, α]] // CC[u,-α]),
t0 ≡ t1
};