(* ::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.                                                         *)
(************************************************************************)



Domain[f_List] := First /@ f;
f_\[Backslash]key_ := DeleteCases[f, key -> _];
f_ \[Backslash] keys_List := Fold[#1\[Backslash]#2&, f, keys];
f1_List \[Congruent] f2_List := Domain[f1]===Domain[f2] && (And @@ (
((#/.f1)\[Congruent](#/.f2))& /@ Domain[f1]
));
LieMorphism[mor_][f_List] := MapAt[LieMorphism[mor], f, {All, 2}];
Domain[M[f_List, _]] := Domain[f];
M[\[Lambda]1_, \[Omega]1_] \[Congruent] M[\[Lambda]2_, \[Omega]2_] := (\[Lambda]1\[Congruent]\[Lambda]2) && (\[Omega]1\[Congruent]\[Omega]2);
M[_, \[Omega]_][W] := \[Omega];
M[\[Lambda]_, _][x_] := (x/.\[Lambda]);


CC[u_, \[Gamma]_LieSeries] := LieMorphism[\[LeftAngleBracket]u\[RightAngleBracket]-> Ad[\[Gamma]][\[LeftAngleBracket]u\[RightAngleBracket]]];
Subscript[CC, u_][\[Gamma]_] := CC[u,\[Gamma]];
RC[u_, \[Gamma]_LieSeries, ub_][ser_] := StableApply[LieMorphism[\[LeftAngleBracket]u\[RightAngleBracket] -> Ad[\[Gamma]][\[LeftAngleBracket]ub\[RightAngleBracket]]], ser];
RC[u_, \[Gamma]_LieSeries][ser_] := ser // RC[u, \[Gamma],\[LeftAngleBracket]\[Upsilon]\[RightAngleBracket]] // LieMorphism[\[LeftAngleBracket]\[Upsilon]\[RightAngleBracket]->\[LeftAngleBracket]u\[RightAngleBracket]];
Subscript[RC, u_][\[Gamma]_] := RC[u,\[Gamma]];
J[u_LW, \[Gamma]_] := Module[{s}, \!\(
\*SubsuperscriptBox[\(\[Integral]\), \(0\), \(1\)]\(\((\(\(\[Gamma]\  // \ 
\(\*SubscriptBox[\(RC\), \(u\)]\)[s\ \[Gamma]]\)\  // \ 
\*SubscriptBox[\(div\), \(u\)]\)\  // \ 
\(\*SubscriptBox[\(CC\), \(u\)]\)[\(-s\)\ \[Gamma]])\) \[DifferentialD]s\)\)];
J[u_, \[Gamma]_] := J[\[LeftAngleBracket]u\[RightAngleBracket],\[Gamma]];
Subscript[J, u_][\[Gamma]_] := J[u,\[Gamma]];


M /: M[\[Lambda]1_, \[Omega]1_]\[Union] M[\[Lambda]2_, \[Omega]2_] := M[\[Lambda]1 \[Union] \[Lambda]2, \[Omega]1+\[Omega]2];


t\[Sigma][us_List -> vs_List][ser_LieSeries|ser_CWSeries|ser_List] := ser // LieMorphism[Thread[(LW/@us)->(LW/@vs)]];
t\[Sigma][u_, v_] := t\[Sigma][{u}->{v}];
t\[Sigma][uvs__][\[Mu]_M] := t\[Sigma][uvs] /@ \[Mu];
h\[Sigma][xs_List -> ys_List][\[Lambda]_List] := Union[\[Lambda]\[Backslash]xs, Thread[ys-> (xs/.\[Lambda])]];
h\[Sigma][x_, y_] := h\[Sigma][{x}->{y}];
h\[Sigma][xys__][M[\[Lambda]_, \[Omega]_]] := M[\[Lambda]//h\[Sigma][xys], \[Omega]];
d\[Sigma][abs__][\[Mu]_] := \[Mu] // t\[Sigma][abs] // h\[Sigma][abs];


h\[Eta][x_][M[\[Lambda]_,\[Omega]_]] := M[\[Lambda]\[Backslash]x, \[Omega]];


tm[u_,v_,w_][\[Lambda]_List] := \[Lambda] //  LieMorphism[\[LeftAngleBracket]u\[RightAngleBracket]->\[LeftAngleBracket]w\[RightAngleBracket], \[LeftAngleBracket]v\[RightAngleBracket]->\[LeftAngleBracket]w\[RightAngleBracket]];
tm[u_,v_,w_][M[\[Lambda]_, \[Omega]_]] := LieMorphism[\[LeftAngleBracket]u\[RightAngleBracket]->\[LeftAngleBracket]w\[RightAngleBracket], \[LeftAngleBracket]v\[RightAngleBracket]->\[LeftAngleBracket]w\[RightAngleBracket]] /@ M[\[Lambda], \[Omega]];
hm[x_,y_,z_][\[Lambda]_List] := Union[\[Lambda]\[Backslash]{x,y}, {z->BCH[x/.\[Lambda], y/.\[Lambda]]}];
hm[x_,y_,z_][M[\[Lambda]_, \[Omega]_]] := M[\[Lambda] // hm[x,y,z], \[Omega]];
tha[u_, x_][\[Lambda]_List] := MapAt[RC[u, x /. \[Lambda]], \[Lambda], {All, 2}];
tha[u_, x_][M[\[Lambda]_, \[Omega]_]] := M[\[Lambda] // tha[u,x], (\[Omega]+J[u,x /. \[Lambda]]) // RC[u, x /. \[Lambda]]];
dm[a_,b_,c_][\[Mu]_] := \[Mu] // tha[\[LeftAngleBracket]a\[RightAngleBracket],b] // tm[\[LeftAngleBracket]a\[RightAngleBracket],\[LeftAngleBracket]b\[RightAngleBracket],\[LeftAngleBracket]c\[RightAngleBracket]] // hm[a,b,c];


t\[CapitalDelta][u_,v_, w_][\[Mu]_M] := LieMorphism[\[LeftAngleBracket]u\[RightAngleBracket]->\[LeftAngleBracket]v\[RightAngleBracket]+\[LeftAngleBracket]w\[RightAngleBracket]] /@ \[Mu];
h\[CapitalDelta][x_,y_,z_][M[\[Lambda]_, \[Omega]_]] := M[Union[\[Lambda]\[Backslash]x, {y->(x/.\[Lambda]), z->(x/.\[Lambda])}], \[Omega]];
d\[CapitalDelta][a_,b_,c_][\[Mu]_M] := \[Mu] // t\[CapitalDelta][a,b,c] // h\[CapitalDelta][a,b,c];


tS[u_][\[Mu]_M] := LieMorphism[\[LeftAngleBracket]u\[RightAngleBracket]->-\[LeftAngleBracket]u\[RightAngleBracket]] /@ \[Mu];
hS[x_][M[\[Lambda]_, \[Omega]_]] := M[Union[\[Lambda]\[Backslash]x, {x->-(x/.\[Lambda])}], \[Omega]];
dS[a_][\[Mu]_] := \[Mu] // tS[a]//hS[a] // tha[a,a] ;


tA[u_][expr_] := expr;
hA[x_][M[\[Lambda]_, \[Omega]_]] := M[Union[\[Lambda]\[Backslash]x, {x->-(x/.\[Lambda])}], \[Omega]];
dA[a_][\[Mu]_] := \[Mu] // hA[a] // tha[a,a];


dc[a_][\[Mu]_] := \[Mu] // hS[a] // tha[a,a] // hS[a] // h\[Eta][a];


t\[Epsilon][u_] := M[{}, MakeCWSeries[0]];
h\[Epsilon][x_] := M[{x->MakeLieSeries[0]}, MakeCWSeries[0]];
d\[Epsilon][a_] := t\[Epsilon][a]\[Union]h\[Epsilon][a];
SuperPlus[\[Rho]][u_,x_] := M[{x->MakeLieSeries[\[LeftAngleBracket]u\[RightAngleBracket]]}, MakeCWSeries[0]];
SuperMinus[\[Rho]][u_,x_] := M[{x->MakeLieSeries[-\[LeftAngleBracket]u\[RightAngleBracket]]}, MakeCWSeries[0]];
SuperPlus[R][a_,b_] := SuperPlus[\[Rho]][a,b]\[Union]M[{a->MakeLieSeries[0]}, MakeCWSeries[0]];
SuperMinus[R][a_,b_] := SuperMinus[\[Rho]][a,b]\[Union]M[{a->MakeLieSeries[0]}, MakeCWSeries[0]];
R[a_,b_, p_] /; a!=b := M[{a->MakeLieSeries[0], b->MakeLieSeries[p \[LeftAngleBracket]a\[RightAngleBracket]]}, MakeCWSeries[0]];
R[a_,a_, p_] := M[{a->MakeLieSeries[p \[LeftAngleBracket]a\[RightAngleBracket]]}, MakeCWSeries[0]];
\[CapitalTheta][a_,b_,p_]:=(R[a,a,p/2] // d\[CapitalDelta][a,a,b])**R[a,a,-p/2]**R[b,b,-p/2];
\[CapitalTheta][a_,b_] := \[CapitalTheta][a,b,1];


M /: \[Mu]1_M ** \[Mu]2_M := Module[{d1,d2,dom, \[Mu]1p=\[Mu]1, \[Mu]2p=\[Mu]2, s},
{d1=Domain[\[Mu]1], d2=Domain[\[Mu]2], dom=Union[d1, d2]};
Do[\[Mu]1p = \[Mu]1p\[Union]d\[Epsilon][a], {a, Complement[d2, d1]}];
Do[\[Mu]2p = \[Mu]2p\[Union]d\[Epsilon][a], {a, Complement[d1, d2]}];
s=Max[dom]-Min[dom]+1;
Do[\[Mu]2p= \[Mu]2p // d\[Sigma][a, a+s],{a, dom}];
Fold[(#1//dm[#2,#2+s,#2])&, \[Mu]1p\[Union]\[Mu]2p, dom]
];
