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



BeginPackage["AwCalculus`", {"FreeLie`"}];
Print["AwCalculus` implements / extends ",
Sort@{"*","**","\[Congruent]",dA,dc,deg,dm,dS,d\[CapitalDelta],d\[Eta],d\[Sigma],El, Es,hA,hm,hS,h\[CapitalDelta],h\[Eta],h\[Sigma],tA,tha,tm,tS,t\[CapitalDelta],t\[Eta],t\[Sigma],\[CapitalGamma],\[CapitalLambda], RandomEsSeries, RandomElSeries},
"."];
Print["AwCalculus` is in the public domain. Dror Bar-Natan is committed to support it within reason until July 15, 2022. This is version 150909."];
Begin["`Private`"];


deg /: (h_)^deg:=DegreeScale[h];


El[\[Lambda]_,\[Omega]_][d_] := El[\[Lambda][d], \[Omega][d]];
El /: El[\[Lambda]1_,\[Omega]1_]\[Congruent]El[\[Lambda]2_,\[Omega]2_] := (\[Lambda]1\[Congruent]\[Lambda]2) && (\[Omega]1\[Congruent]\[Omega]2);El /: El[\[Lambda]1_,\[Omega]1_]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[Subscript[BCH, tb][\[Lambda]1, \[Lambda]2], (E^-Subscript[D, \[Lambda]2])[\[Omega]1]+\[Omega]2];


El /: El[\[Lambda]1_,\[Omega]1_]**El[\[Lambda]2_,\[Omega]2_] := NonCommutativeMultiply[
El[\[Lambda]1\[Union]((#->LS[0])& /@ \[LeftAngleBracket]Complement[Support@\[Lambda]2, Support@\[Lambda]1]\[RightAngleBracket]), \[Omega]1],
El[\[Lambda]2\[Union]((#->LS[0])& /@ \[LeftAngleBracket]Complement[Support@\[Lambda]1, Support@\[Lambda]2]\[RightAngleBracket]), \[Omega]2]
]


El /: El[\[Lambda]_,\[Omega]_]^-1 := El[-\[Lambda], -(E^Subscript[D, \[Lambda]])[\[Omega]]]


El[\[Lambda]_,\[Omega]_] // d\[Eta][s_] := El[(\[Lambda]\[Backslash]s)//LieMorphism[LW[s]->0], \[Omega]//LieMorphism[LW[s]->0]];
d\[Eta] /: d\[Eta]^a_ := d\[Eta][a];


El[\[Lambda]_,\[Omega]_] // dA := El[-\[Lambda], (E^Subscript[D, \[Lambda]])[\[Omega]]-j[\[Lambda]]];


\[Zeta]_El // DegreeScale[h_] := DegreeScale[h] /@ \[Zeta];
\[Zeta]_El // dS := \[Zeta] // dA // (-1)^deg;


El[\[Lambda]_,\[Omega]_] // d\[CapitalDelta][a_,b_,c_] := El[
(\[Lambda]\[Backslash]a)\[Union]\[LeftAngleBracket]b->Subscript[\[Lambda], a],c->Subscript[\[Lambda], a]\[RightAngleBracket]//LieMorphism[LW@a->LW@b+LW@c],
\[Omega]//LieMorphism[LW@a->LW@b+LW@c]]


Es /: Es[\[Lambda]1_,\[Omega]1_]\[Congruent]Es[\[Lambda]2_,\[Omega]2_] := (\[Lambda]1\[Congruent]\[Lambda]2) && (\[Omega]1\[Congruent]\[Omega]2);
Es[\[Lambda]_,\[Omega]_][d_] := Es[\[Lambda][d], \[Omega][d]];


Es /: Es[\[Lambda]1_,\[Omega]1_]Es[\[Lambda]2_,\[Omega]2_] /; Support[\[Lambda]1]\[Intersection]Support[\[Lambda]2]=={} := Es[\[Lambda]1\[Union]\[Lambda]2, \[Omega]1+\[Omega]2];
Es[\[Lambda]_, \[Omega]_] // hm[x_,y_,z_] := Es[\[Lambda] // hm[x,y,z], \[Omega]];
Es[\[Lambda]_, \[Omega]_] // tm[u_,v_,w_] := LieMorphism[LW@u->LW@w, LW@v->LW@w] /@ Es[\[Lambda], \[Omega]];
Es[\[Lambda]_, \[Omega]_] // tha[u_, x_] := Es[\[Lambda] // Subscript[RC, u][Subscript[\[Lambda], x]], (\[Omega]+Subscript[J, u][Subscript[\[Lambda], x]]) // Subscript[RC, u][Subscript[\[Lambda], x]]];


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];


\[Zeta]_Es // dm[a_,b_,c_] := \[Zeta] // tha[a,b] // tm[a,b,c] // hm[a,b,c];


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


bar[LW[a_]] := LW[bar[a]];


Es /: Es[\[Lambda]1_,\[Omega]1_]**Es[\[Lambda]2_,\[Omega]2_] /; Support[\[Lambda]1]==Support[\[Lambda]2]:= Module[
{S= Support[\[Lambda]1], \[Zeta], a},
\[Zeta] = Es[\[Lambda]1,\[Omega]1] * (Es[\[Lambda]2, \[Omega]2] // d\[Sigma][S->(bar/@S)]);
Table[\[Zeta]=\[Zeta]//dm[a,bar[a],a], {a,S}] // Last
];


Es /: Es[\[Lambda]1_,\[Omega]1_]**Es[\[Lambda]2_,\[Omega]2_] := NonCommutativeMultiply[
Es[\[Lambda]1\[Union]((#->LS[0])& /@ \[LeftAngleBracket]Complement[Support@\[Lambda]2, Support@\[Lambda]1]\[RightAngleBracket]), \[Omega]1],
Es[\[Lambda]2\[Union]((#->LS[0])& /@ \[LeftAngleBracket]Complement[Support@\[Lambda]1, Support@\[Lambda]2]\[RightAngleBracket]), \[Omega]2]
];
Es /: (\[Zeta]_Es)^-1 := \[CapitalGamma][\[CapitalLambda][\[Zeta]]^-1];


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]])


\[Zeta]_Es // DegreeScale[h_] := DegreeScale[h] /@ \[Zeta];


Es[\[Lambda]_,\[Omega]_] // h\[Eta][s_] := Es[\[Lambda]\[Backslash]s, \[Omega]];
h\[Eta] /: h\[Eta]^x_ := h\[Eta][x];
Es[\[Lambda]_, \[Omega]_] // t\[Eta][u_] := LieMorphism[LW@u -> 0] /@ Es[\[Lambda], \[Omega]];
t\[Eta] /: t\[Eta]^u_ := t\[Eta][u];


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


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


\[Xi]_Es // \[Sigma][s___List] := Module[{\[Xi]1},
\[Xi]1 = \[Xi] // d\[Sigma][Range[Length@{s}] -> First /@ {s}];
Do[
\[Xi]1 = \[Xi]1 // d\[CapitalDelta][{s}[[i,1]], {s}[[i,1]], {s}[[i,j]]],
{i,Length@{s}}, {j,2,Length@{s}[[i]]}
];
\[Xi]1
]


\[CapitalGamma][El[\[Lambda]_,\[Omega]_]] := Es[\[CapitalGamma][\[Lambda]], \[Omega]];
\[CapitalLambda][Es[\[Lambda]_,\[Omega]_]] := El[\[CapitalLambda][\[Lambda]], \[Omega]];


RandomElSeries[seed_, S_List] := (SeedRandom[seed];
El[\[LeftAngleBracket]Table[a->RandomLieSeries[S], {a,S}]\[RightAngleBracket], RandomCWSeries[S]]);
RandomEsSeries[seed_, S_List] := (SeedRandom[seed];
Es[\[LeftAngleBracket]Table[a->RandomLieSeries[S], {a,S}]\[RightAngleBracket], RandomCWSeries[S]]);


End[]; EndPackage[];
