(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



\[LeftAngleBracket]{\[Lambda]___}\[RightAngleBracket] := \[LeftAngleBracket]\[Lambda]\[RightAngleBracket];
Support[\[LeftAngleBracket]\[Lambda]___\[RightAngleBracket]] := First /@ {\[Lambda]};
\[Lambda]_\[Backslash]key_ := DeleteCases[\[Lambda], key -> _];
\[Lambda]_ \[Backslash] keys_List := Fold[#1\[Backslash]#2&, \[Lambda], keys];
Subscript[\[LeftAngleBracket]\[Lambda]___\[RightAngleBracket], s_] := s /. {\[Lambda]};
(\[Lambda]_AngleBracket)[d_] := \[LeftAngleBracket]Table[u -> Subscript[\[Lambda], u][d],{u, Support[\[Lambda]]}]\[RightAngleBracket];
Crop[\[Lambda]_AngleBracket, d_] := MapAt[Crop[#,d]&, \[Lambda], {All,2}];
AngleBracket /: Plus[\[Lambda]s__AngleBracket] := \[LeftAngleBracket]Table[
u -> Total[Subscript[#, u]& /@ {\[Lambda]s}],
{u, Union@@(Support[#]& /@ {\[Lambda]s})}
]\[RightAngleBracket];
AngleBracket /: c_*\[Lambda]_AngleBracket := \[LeftAngleBracket]Table[
u -> Expand[c Subscript[\[Lambda], u]],
{u, Support[\[Lambda]]}
]\[RightAngleBracket];
AngleBracket /: \[Lambda]_AngleBracket // mor_LieMorphism := MapAt[mor, \[Lambda], {All,2}];
\[Lambda]_AngleBracket //  DegreeScale[h_] := MapAt[DegreeScale[h], \[Lambda], {All,2}];
deg /: (h_)^deg:=DegreeScale[h];


TangentialDerivation[\[LeftAngleBracket]\[Lambda]___\[RightAngleBracket]] := LieDerivation[{\[Lambda]} /. (s_->\[Lambda]s_):>(LW[s]->b[LW[s],\[Lambda]s])];
tb[\[Lambda]1_AngleBracket, \[Lambda]2_AngleBracket] /; Support[\[Lambda]1]==Support[\[Lambda]2] := \[LeftAngleBracket]Table[
s -> b[Subscript[\[Lambda]1, s], Subscript[\[Lambda]2, s]] + TangentialDerivation[\[Lambda]1][Subscript[\[Lambda]2, s]] - TangentialDerivation[\[Lambda]2][Subscript[\[Lambda]1, s]],
{s, Support[\[Lambda]1]}
]\[RightAngleBracket];
div[\[Lambda]_AngleBracket] := Sum[Subscript[div, s][Subscript[\[Lambda], s]], {s, Support[\[Lambda]]}];
j[\[Lambda]_AngleBracket] := DerivationSeries[(E^der-1)/der, TangentialDerivation[\[Lambda]]][div[\[Lambda]]];


LieMorphism[rules__Rule, keys_AngleBracket, br_] := LieMorphism[{rules}, keys, br];
LieMorphism[rules_List, keys_AngleBracket, br_] := New[LieMorphism[mor],
mor[Support] = First /@ rules;
(mor[w_LW] /; Deg[w] == 1) := (mor[w] = w /. rules);
mor[w_LW] := (mor[w] = br @@ (mor /@ LyndonFactorization[w]));
mor[expr_][d_] := Expand[expr /. w_LW :> mor[w][d]];
mor[ls_LieSeries] := mor[ls] = Module[{ser},
\[LeftAngleBracket]Table[
ReleaseHold[Hold[
ser[]=Hold[AngleBracketFromLieMorphism[mor, ls, ss]];
ser[d_Integer] := ser[d] = Subscript[(\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(k = 1\), \(d\)]\(\(mor[ls[k]]\)[d]\)\)), ss];
ss->LieSeries[ser]
] /. {ss->s, ser -> Unique[LieSeriesInAngleBracket]}],
{s, List@@keys}
]\[RightAngleBracket]]
];
BCH[x_, y_, keys_AngleBracket, br_] := LieMorphism[{LW["x"] -> x, LW["y"] -> y}, keys, br][BCHBase];


El /: El[\[Lambda]1_,\[Omega]1_]\[Union]El[\[Lambda]2_,\[Omega]2_] /; Support[\[Lambda]1]\[Intersection]Support[\[Lambda]2]=={} := El[\[Lambda]1\[Union]\[Lambda]2, \[Omega]1+\[Omega]2];
El /: El[\[Lambda]1_,\[Omega]1_]**El[\[Lambda]2_,\[Omega]2_] /; Support[\[Lambda]1]==Support[\[Lambda]2]:= El[BCH[\[Lambda]1, \[Lambda]2, \[LeftAngleBracket]1,2\[RightAngleBracket], tb], \[Omega]1+DerivationExp[TangentialDerivation[\[Lambda]1]][\[Omega]2]];
El[\[Lambda]_,\[Omega]_] // dA := El[-\[Lambda], DerivationExp[TangentialDerivation[\[Lambda]]][\[Omega]]-j[\[Lambda]]];
El[\[Lambda]_,\[Omega]_] // dS := El[
-\[Lambda] // (-1)^deg,
(DerivationExp[TangentialDerivation[\[Lambda]]][\[Omega]]-j[\[Lambda]]) // (-1)^deg
];


Es /: Es[\[Lambda]1_,\[Omega]1_]\[Union]Es[\[Lambda]2_,\[Omega]2_] /; Support[\[Lambda]1]\[Intersection]Support[\[Lambda]2]=={} := Es[\[Lambda]1\[Union]\[Lambda]2, \[Omega]1+\[Omega]2];


t\[Sigma][us_List -> vs_List][ser_LieSeries|ser_CWSeries|ser_AngleBracket] := ser // LieMorphism[Thread[(LW/@us)->(LW/@vs)]];
t\[Sigma][u_, v_] := t\[Sigma][{u}->{v}];
t\[Sigma][us_List -> vs_List][\[Zeta]_Es] := t\[Sigma][us->vs] /@ \[Zeta];
h\[Sigma][xs_List -> ys_List][\[Lambda]_AngleBracket] := Union[\[Lambda]\[Backslash]xs, \[LeftAngleBracket]Thread[ys-> Table[Subscript[\[Lambda], x],{x, xs}]]\[RightAngleBracket]];
h\[Sigma][x_, y_] := h\[Sigma][{x}->{y}];
h\[Sigma][xs_List -> ys_List][Es[\[Lambda]_, \[Omega]_]] := Es[\[Lambda]//h\[Sigma][xs->ys], \[Omega]];
d\[Sigma][as_List -> bs_List][\[Zeta]_] := \[Zeta] // t\[Sigma][as->bs] // h\[Sigma][as->bs];
d\[Sigma][a_, b_][\[Zeta]_] := \[Zeta] // t\[Sigma][a,b] // h\[Sigma][a,b];


tm[u_,v_,w_][\[Lambda]_AngleBracket] := \[Lambda] //  LieMorphism[LW@u->LW@w, LW@v->LW@w];
tm[u_,v_,w_][Es[\[Lambda]_, \[Omega]_]] := LieMorphism[LW@u->LW@w, LW@v->LW@w] /@ Es[\[Lambda], \[Omega]];
hm[x_,y_,z_][\[Lambda]_AngleBracket] := Union[\[Lambda]\[Backslash]{x,y}, \[LeftAngleBracket]z->BCH[Subscript[\[Lambda], x], Subscript[\[Lambda], y]]\[RightAngleBracket]];
hm[x_,y_,z_][Es[\[Lambda]_, \[Omega]_]] := Es[\[Lambda] // hm[x,y,z], \[Omega]];
tha[u_LW, x_][\[Lambda]_AngleBracket] := \[Lambda] // Subscript[RC, u][Subscript[\[Lambda], x]];
tha[u_LW, x_][Es[\[Lambda]_, \[Omega]_]] := Es[\[Lambda] // tha[u,x], (\[Omega]+Subscript[J, u][Subscript[\[Lambda], x]]) // Subscript[RC, u][Subscript[\[Lambda], x]]];
dm[a_,b_,c_][\[Zeta]_] := \[Zeta] // tha[LW@a,b] // tm[LW@a,LW@b,LW@c] // hm[a,b,c];
dm[a_,b_,rest__,c_][\[Zeta]_] := \[Zeta] // dm[b,rest, b] // dm[a,b,c];


Es /: Es[\[Lambda]1_,\[Omega]1_]**Es[\[Lambda]2_,\[Omega]2_] /; Support[\[Lambda]1]==Support[\[Lambda]2]:= Module[
{supp, temps, \[Zeta]},
supp = Support[\[Lambda]1];
temps=Complement[Characters["0123456789abcdefghijklmnopqrstuvwxyz"], ToString /@ supp][[1;;Length@supp]];
\[Zeta]=Es[\[Lambda]1,\[Omega]1]\[Union](Es[\[Lambda]2, \[Omega]2] // d\[Sigma][supp->temps]);
MapThread[(\[Zeta]=\[Zeta]//dm[#1,#2,#1])&, {supp,temps}] // Last
];


tA[u_][expr_] := expr;
hA[x_][Es[\[Lambda]_, \[Omega]_]] := Es[Union[\[Lambda]\[Backslash]x, \[LeftAngleBracket]x->-Subscript[\[Lambda], x]\[RightAngleBracket]], \[Omega]];
dA[a_][\[Mu]_] := \[Mu] // hA[a] // tha[LW@a,a];
dA[a_, rest__][\[Mu]_] := \[Mu] // dA[a] // dA[rest];
Es[\[Lambda]_, \[Omega]_] // dA := Es[\[Lambda],\[Omega]] // (dA@@Support[\[Lambda]])


tS[u_][\[Lambda]_AngleBracket] := \[LeftAngleBracket]Table[x -> LieMorphism[LW@u -> -LW@u][Subscript[\[Lambda], x]], {x, Support[\[Lambda]]}]\[RightAngleBracket];
tS[u_][Es[\[Lambda]_,\[Omega]_]] := Es[\[Lambda] // tS[u], \[Omega] // LieMorphism[LW@u -> -LW@u]];
hS[x_][Es[\[Lambda]_, \[Omega]_]] := Es[Union[\[Lambda]\[Backslash]x, \[LeftAngleBracket]x->-Subscript[\[Lambda], x]\[RightAngleBracket]], \[Omega]];
dS[a_][\[Mu]_] := \[Mu] // tS[a] // hS[a] // tha[LW@a,a];
dS[a_, rest__][\[Mu]_] := \[Mu] // dS[a] // dS[rest];
Es[\[Lambda]_, \[Omega]_] // dS := Es[\[Lambda],\[Omega]] // (dS@@Support[\[Lambda]])


\[CapitalGamma][-1, \[Lambda]_AngleBracket, _] := \[LeftAngleBracket]Table[s->MakeLieSeries[0], {s, Support[\[Lambda]]}]\[RightAngleBracket];
\[CapitalGamma][n_, \[Lambda]_AngleBracket, t_] := \[CapitalGamma][n,\[Lambda],t] = Module[{\[Tau],\[CapitalGamma]0},
\[CapitalGamma]0=\[CapitalGamma][n-1,\[Lambda],\[Tau]];
\[LeftAngleBracket]Table[
s->\!\(
\*SubsuperscriptBox[\(\[Integral]\), \(0\), \(t\)]\(\((\(
\*SubscriptBox[\(\[Lambda]\), \(s\)]\  // \ DerivationExp[\(-\[Tau]\)\ TangentialDerivation[\[Lambda]]]\)\  // \ adSeries[
\*FractionBox[\(ad\), \(
\*SuperscriptBox[\(E\), \(ad\)] - 1\)], \ 
\*SubscriptBox[\(\[CapitalGamma]0\), \(s\)]])\) \[DifferentialD]\[Tau]\)\),
{s, Support[\[Lambda]]}
]\[RightAngleBracket]
];
\[CapitalGamma][\[Lambda]_AngleBracket, t_] := \[CapitalGamma][\[Lambda],t] = \[LeftAngleBracket]Table[
s -> New[LieSeries[ser],
With[{s=s}, ser[d_Integer] := ser[d] = (Subscript[\[CapitalGamma][d-1, \[Lambda],t], s])[d]];
],
{s, Support[\[Lambda]]}
]\[RightAngleBracket];
\[CapitalGamma][\[Lambda]_AngleBracket] := \[CapitalGamma][\[Lambda],1];
\[CapitalGamma]i[\[Lambda]_AngleBracket] := \[CapitalGamma]i[\[Lambda]] = \[LeftAngleBracket]Table[With[{s=s},
s->New[LieSeries[ser],
ser[d_Integer] := ser[d] = Subscript[\[Lambda], s][d]-Subscript[\[CapitalGamma][Crop[\[CapitalGamma]i[\[Lambda]], d-1]], s][d]
]],
{s, Support[\[Lambda]]}
]\[RightAngleBracket];
\[CapitalGamma] /: \[CapitalGamma]^-1 = \[CapitalGamma]i;
Es[El[\[Lambda]_,\[Omega]_]] := Es[\[CapitalGamma][\[Lambda]], \[Omega]];
El[Es[\[Lambda]_,\[Omega]_]] := El[(\[CapitalGamma]^-1)[\[Lambda]], \[Omega]];
