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



(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\People\\Kuno"];
<< FreeLie.m


(* ::Input::Initialization:: *)
Antipode[w_AW]:=Antipode[w]=(-1)^Length[w] Reverse[w];
Antipode[expr_]:=Expand[expr/.w_AW:>Antipode[w]]


(* ::Input::Initialization:: *)
EDKBasis[ps_List, s_Integer, d_Integer]:= Flatten@{
Table[EDK[j,k,#]&/@AllWords[d-1,ps],{j,1,s-1},{k,j+1,s}],
Table[EDK[k,#]&/@AllLyndonWords[d,ps],{k,s}]
}


(* ::Input::Initialization:: *)
EDK[j_,k_,w_AW]/;j>k:=EDK[k,j,Antipode[w]];


(* ::Input::Initialization:: *)
EDK[__,0]=0;
EDK /: EDK[jk__, x1_] + EDK[jk__, x2_] := EDK[jk, x1+x2];
EDK /: c_*EDK[jk__, x_] := EDK[jk, Expand[c x]];
EDK /: b[EDK[jk1__, c_*(x1_LW|x1_AW)], EDK[jk2__, x2_]] := Expand[c b[EDK[jk1, x1], EDK[jk2,x2]]];
EDK /: b[EDK[jk1__, x1_], EDK[jk2__, c_*(x2_LW|x2_AW)]] := Expand[c b[EDK[jk1, x1], EDK[jk2,x2]]];
EDK /: b[EDK[jk1__, x1_], EDK[jk2__,x2_Plus]]:= b[EDK[jk1, x1],EDK[jk2,#]]&/@x2;
EDK /: b[EDK[jk1__,x1_Plus], EDK[jk2__,x2_]] := b[EDK[jk1,#],EDK[jk2,x2]]&/@x1;


(* ::Input::Initialization:: *)
EDK /: b[EDK[_,_,_],EDK[_,_,_]]:=0


(* ::Input::Initialization:: *)
EDK/: b[EDK[k1_,w1_LW],EDK[j2_,k2_,w2_AW]] := Which[
k1==j2, -EDK[j2,k2,w2**\[Iota][w1]],
k1==k2, EDK[j2,k2,\[Iota][w1]**w2],
True,0
];
EDK/: b[EDK[j2_,k2_,w2_AW], EDK[k1_,w1_LW]]:=Expand[-b[EDK[k1,w1],EDK[j2,k2,w2]]]


(* ::Input::Initialization:: *)
EDK/: b[EDK[k1_,w1_LW],EDK[k2_,w2_LW]] := Which[
k1==k2,EDK[k1,b[w1,w2]],
k1<k2,EDK[k1,k2,Sum[\[Tau][LW@p,w2]**AW[p]**Antipode[\[Tau][LW@p,w1]],{p,Union[List@@w1]\[Intersection]Union[List@@w2]}]],
k2<k1,EDK[k2,k1,Sum[-\[Tau][LW@p,w1]**AW[p]**Antipode[\[Tau][LW@p,w2]],{p,Union[List@@w1]\[Intersection]Union[List@@w2]}]]
]


(* ::Input::Initialization:: *)
\[Sigma] /: \[ScriptCapitalE]_^s_\[Sigma] := s[\[ScriptCapitalE]];
\[Sigma][lft___, i_Integer, rgt___] := \[Sigma][lft, IntegerDigits[i], rgt];
\[Sigma][___][0]=0;
x_Plus // s_\[Sigma] := s[#]& /@ x;
EDK[jk__, x_Plus] //s_\[Sigma]:= s[EDK[jk, #]]& /@ x;
EDK[jk__, c_*(w_LW|w_AW)] // s_\[Sigma] := Expand[c*s[EDK[jk,w]]];
EDK[k_, LW[x_]] // s_\[Sigma] := Sum[EDK[\[Alpha],LW[x]], {\[Alpha], s[[k]]}];
EDK[k_, w_LW] // s_\[Sigma] := b@@(s[EDK[k,#]]& /@ LyndonFactorization[w]);
EDK[j_,k_,AW[]] // s_\[Sigma] := Sum[EDK[\[Alpha],\[Beta],AW[]],{\[Alpha],s[[j]]},{\[Beta],s[[k]]}];
EDK[j_,k_,AW[x_,w___]] // s_\[Sigma] := b[s@EDK[k,LW@x],s@EDK[j,k,AW[w]]]


(* ::Input::Initialization:: *)
ps\[CapitalDelta][_][0]=0;
x_Plus // ps\[CapitalDelta][y_] := ps\[CapitalDelta][y]/@ x;
EDK[k_,x_]//ps\[CapitalDelta][y_] := EDK[k+1,x]+EDK[1,k+1,\[Tau][LW@y,x]];
EDK[j_,k_,x_]//ps\[CapitalDelta][_]  := EDK[j+1,k+1,x];


(* ::Input::Initialization:: *)
LM[___][0]=0;
x_Plus // lm_LM := lm/@ x;
lm_LM[c_ w_LW]:=Expand[c lm[w]];
lm_LM[c_ w_AW]:=Expand[c lm[w]];
lm_LM[EDK[jk__,x_]]:=EDK[jk,Expand[lm[x]]];
LM[rules___][LW[w_]]:=Distribute[LW[w]/.{rules}]/.LW[0]->0;
LM[rules___][w_LW] := (LM[rules][w] = b @@ (LM[rules] /@ LyndonFactorization[w]));
LM[rules___][AW[]] =AW[];
LM[rules___][AW[w_]] := Distribute[AW[w]/.{rules}]/.AW[0]->0;
LM[rules___][w_AW] := LM[rules][w] = Module[{w1,w2},
w1=Take[w, Floor[Length[w]/2]];
w2=Drop[w, Floor[Length[w]/2]];
LM[rules][w1]**LM[rules][w2]
];



