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



\[Epsilon] /: \[Epsilon]^2=0;
PBWBasis={c,u,w};
FullPBWBasis=PBWBasis\[Union](Subscript[#, _]& /@ PBWBasis)\[Union]{\[Epsilon]};
IndexedScalars={b};
b[c,w]=-(b[w,c]=w);
b[u,c]=-(b[c,u]=u);
b[w,u]=-(b[u,w]=b-2\[Epsilon] c);


b[x_,x_]=0;
b[Subscript[(x_), i_],Subscript[(y_), i_]]:=b[Subscript[x, i],Subscript[y, i]]=b[x,y]/.Table[z->Subscript[z, i],{z,PBWBasis\[Union]IndexedScalars}];
b[Subscript[(x_), i_],Subscript[(y_), j_]] /; i=!=j := 0;
b[x_,y_] := x**y-y**x;


Simp[\[ScriptCapitalE]_]:= Collect[\[ScriptCapitalE], FullPBWBasis, Simplify]


ScalarQ = FreeQ[Alternatives@@PBWBasis];
AtomicQ = MatchQ[Alternatives@@Flatten[{#,Subscript[#, _]}& /@ PBWBasis]];
DecomposableQ[x_Plus] = False; DecomposableQ[x_] := !(ScalarQ[x]\[Or]AtomicQ[x]);
Type[Subscript[(x_), _]]:=Type[x];
Type /: Type[x_]<Type[y_] := Position[PBWBasis,x][[1,1]]<Position[PBWBasis,y][[1,1]];
Type /: Type[x_]<=Type[y_] := Position[PBWBasis,x][[1,1]]<=Position[PBWBasis,y][[1,1]];
CleaveLeft = Replace[Flatten[{
{{x_.*#^n_.:>{#, x #^(n-1)}, x_.*Subscript[#, i_]^n_.:>{Subscript[#, i],x Subscript[#, i]^(n-1)}}& /@ PBWBasis},
x_:>{x,1} }]];
CleaveRight = Replace[Flatten[{
{{x_.*#^n_.:>{x #^(n-1),#}, x_.*Subscript[#, i_]^n_.:>{x Subscript[#, i]^(n-1),Subscript[#, i]}}& /@ Reverse@PBWBasis},
x_:>{1,x} }]];


Unprotect[NonCommutativeMultiply];
0**_=_**0=0;
x_**1:=x; 1**x_:=x;
(x_Plus)**y_ := (#**y)& /@ x;
x_**(y_Plus) := (x**#)& /@ y;
x_ ** y_ /; ScalarQ[x]\[Or]ScalarQ[y] := x*y;
x_**y_ /; AtomicQ[x]\[And]AtomicQ[y] := x*y+If[Type[x]<Type[y],0,b[x,y]];
x_ ** y_ /; AtomicQ[x]\[And]DecomposableQ[y] := (
CleaveLeft[y] /. {y1_,y2_} :> If[Type[x]<=Type[y1],x*y,(x**y1)**y2]);
x_**y_ /; DecomposableQ[x]:= (CleaveRight[x] /. {x1_,x2_} :> x1**(x2**y));


LBasis[n_Integer] := LBasis[Range[n]];
LBasis[S_] := Module[{i,j,k,l},SortBy[(# /. {\[Epsilon]->2,Subscript[c, _]->2,Subscript[u, _]->2,Subscript[w, _]->2})&][
Union@Flatten[{{1,\[Epsilon]},
Table[{Subscript[c, i],Subscript[u, i],Subscript[w, i],\[Epsilon] Subscript[c, i],\[Epsilon] Subscript[u, i],\[Epsilon] Subscript[w, i]}, {i,S}],
Table[{Subscript[u, i] Subscript[w, j],\[Epsilon] Subscript[u, i] Subscript[w, j],\[Epsilon] Subscript[c, i] Subscript[c, j],\[Epsilon] Subscript[c, i] Subscript[u, j],\[Epsilon] Subscript[c, i] Subscript[w, j]}, {i,S}, {j,S}],
Table[{\[Epsilon] Subscript[c, i] Subscript[u, j] Subscript[w, k],\[Epsilon] Subscript[u, i] Subscript[u, j] Subscript[w, k],\[Epsilon] Subscript[u, i] Subscript[w, j] Subscript[w, k]}, {i,S}, {j,S},{k,S}],
Table[\[Epsilon] Subscript[u, i] Subscript[u, j] Subscript[w, k] Subscript[w, l], {i,S}, {j,S},{k,S},{l,S}] }]
]]


Subscript[a, i_,j_]:=Subscript[b, i] Subscript[c, j]-\[Epsilon] Subscript[c, i] Subscript[c, j]+Subscript[u, i] Subscript[w, j];


Subscript[R, 0][___][y_]/;ScalarQ[y]:=y;
Subscript[R, 0][x___][y_Plus] := Subscript[R, 0][x] /@ y;
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[c, i_]] := Subscript[c, i]-(E^(-\[Tau] Subscript[b, i]) (-1+E^(\[Tau] Subscript[b, i])) Subscript[u, i] Subscript[w, j])/Subscript[b, i]+(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(\[Tau] Subscript[b, i])-\[Tau] Subscript[b, i]) Subscript[u, i] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)-(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(\[Tau] Subscript[b, i])-\[Tau] Subscript[b, i]) Subscript[c, i] Subscript[u, i] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)+(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(\[Tau] Subscript[b, i])-\[Tau] Subscript[b, i]) Subscript[c, j] Subscript[u, i] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)+(E^(-2 \[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(2 \[Tau] Subscript[b, i])-2 E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) 
\!\(\*SubsuperscriptBox[\(u\), \(i\), \(2\)]\) 
\!\(\*SubsuperscriptBox[\(w\), \(j\), \(2\)]\))/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(3\)]\);
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[c, j_]] := Subscript[c, j]+(E^(-\[Tau] Subscript[b, i]) (-1+E^(\[Tau] Subscript[b, i])) Subscript[u, i] Subscript[w, j])/Subscript[b, i]-(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(\[Tau] Subscript[b, i])-\[Tau] Subscript[b, i]) Subscript[u, i] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)+(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(\[Tau] Subscript[b, i])-\[Tau] Subscript[b, i]) Subscript[c, i] Subscript[u, i] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)-(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(\[Tau] Subscript[b, i])-\[Tau] Subscript[b, i]) Subscript[c, j] Subscript[u, i] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)-(E^(-2 \[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(2 \[Tau] Subscript[b, i])-2 E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) 
\!\(\*SubsuperscriptBox[\(u\), \(i\), \(2\)]\) 
\!\(\*SubsuperscriptBox[\(w\), \(j\), \(2\)]\))/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(3\)]\);
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[c, k_]] /; (k=!=i)\[And](k=!=j):= Subscript[c, k];
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[u, i_]] :=Subscript[u, i]-\[Epsilon] \[Tau] Subscript[c, j] Subscript[u, i]-(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) 
\!\(\*SubsuperscriptBox[\(u\), \(i\), \(2\)]\) Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\);
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[u, j_]] := -(((-1+E^(\[Tau] Subscript[b, i])) Subscript[b, j] Subscript[u, i])/Subscript[b, i])-(\[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) Subscript[b, j] Subscript[u, i])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)+(\[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) Subscript[b, j] Subscript[c, i] Subscript[u, i])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)+(\[Epsilon] (-2 Subscript[b, i]+2 E^(\[Tau] Subscript[b, i]) Subscript[b, i]-Subscript[b, j]+E^(\[Tau] Subscript[b, i]) Subscript[b, j]-\[Tau] Subscript[b, i] Subscript[b, j]) Subscript[c, j] Subscript[u, i])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)+E^(\[Tau] Subscript[b, i]) Subscript[u, j]-E^(\[Tau] Subscript[b, i]) \[Epsilon] \[Tau] Subscript[c, i] Subscript[u, j]-(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-Subscript[b, i]+2 E^(\[Tau] Subscript[b, i]) Subscript[b, i]-E^(2 \[Tau] Subscript[b, i]) Subscript[b, i]+2 E^(\[Tau] Subscript[b, i]) Subscript[b, j]-2 E^(2 \[Tau] Subscript[b, i]) Subscript[b, j]+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i] Subscript[b, j]+E^(2 \[Tau] Subscript[b, i]) \[Tau] Subscript[b, i] Subscript[b, j]) 
\!\(\*SubsuperscriptBox[\(u\), \(i\), \(2\)]\) Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(3\)]\)+(\[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) Subscript[u, i] Subscript[u, j] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\);
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[u, k_]] /; (k=!=i)\[And](k=!=j):= Subscript[u, k];
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[w, i_]] := Subscript[w, i]+\[Epsilon] \[Tau] Subscript[c, j] Subscript[w, i]+E^(-\[Tau] Subscript[b, i]) (-1+E^(\[Tau] Subscript[b, i])) Subscript[w, j]-(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (-1+E^(\[Tau] Subscript[b, i])+\[Tau] Subscript[b, i]) Subscript[c, i] Subscript[w, j])/Subscript[b, i]+(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) Subscript[c, j] Subscript[w, j])/Subscript[b, i]+(E^(-\[Tau] Subscript[b, i]) \[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) Subscript[u, i] Subscript[w, i] Subscript[w, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\)+(E^(-2 \[Tau] Subscript[b, i]) (1+E^(\[Tau] Subscript[b, i])) \[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) Subscript[u, i] 
\!\(\*SubsuperscriptBox[\(w\), \(j\), \(2\)]\))/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\);
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[w, j_]] := E^(-\[Tau] Subscript[b, i]) Subscript[w, j]+E^(-\[Tau] Subscript[b, i]) \[Epsilon] \[Tau] Subscript[c, i] Subscript[w, j]-(E^(-2 \[Tau] Subscript[b, i]) \[Epsilon] (1-E^(\[Tau] Subscript[b, i])+E^(\[Tau] Subscript[b, i]) \[Tau] Subscript[b, i]) Subscript[u, i] 
\!\(\*SubsuperscriptBox[\(w\), \(j\), \(2\)]\))/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\);
Subscript[R, 0][\[Tau]_,i_,j_][Subscript[w, k_]] /; (k=!=i)\[And](k=!=j):= Subscript[w, k];
Subscript[R, 0][x___][y_] := CleaveLeft[y] /. {y1_,y2_} :> Subscript[R, 0][x][y1]**Subscript[R, 0][x][y2];
Subscript[R, 0][i_,j_] := Subscript[R, 0][-1,i,j];

