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



Subscript[e, p_][x_] := x^-p (E^x-\!\(
\*UnderoverscriptBox[\(\[Sum]\), \(k = 0\), \(p - 1\)]
\*FractionBox[
SuperscriptBox[\(x\), \(k\)], \(k!\)]\));
Unprotect[NonCommutativeMultiply];
0**_ := 0; _**0 := 0;
x_**(y_+z_) := x**y+x**z;
(x_+y_)**z_ := x**z+y**z;
L[g_] := L[1,g];
L /: L[f1_,g_] + L[f2_, g_] := L[f1+f2,g];
L /: c_*L[f_,g_] := L[c*f, g];
L /: L[f1_,1]**L[f2_,g_] := L[f1 f2, g];
L /: L[f1_,\[Delta]]**L[f2_,a[i_,j_]] := L[f1 f2, \[Delta]a[i,j]];
L /: L[f1_,c[k_]]**L[f2_,a[i_,j_]] := L[f1 f2, ca[k,i,j]];
L /: L[f1_, \[Delta]a[i_,j_]]**L[f2_,a[k_,l_]] := L[f1 f2, \[Delta]a[i,j,k,l]];
L /: L[_, _c|_ca|_\[Delta]a]**L[_,_c|_ca|_\[Delta]a] := 0;
LSimp[L[f_,g_]] := L[FullSimplify[f], g] /. L[0,_] :> 0;
LSimp[expr_] := expr /. \[Lambda]_L :> LSimp[\[Lambda]];
expr_ // DegreeScale[t_] := expr /. L[f_,g_] :> LSimp[L[
(f /. Subscript[b, i_] :> t Subscript[b, i])*Switch[g,
1,1,
\[Delta],t,
c[_], t,
a[_,_], t,
ca[_,_,_], t^2,
\[Delta]a[_,_,_,_], t^3
],g
]];
expr_ // Ad[t_*a[i_,j_]] := expr // DegreeScale[t^-1] // Ad[a[i,j]] // DegreeScale[t];
DistinctQ[is___] := (Sort[{is}]===Union[{is}]);
expr_ // Ad[a[i_,j_]] := Expand[expr /. {
L[f_,c@i] :> L[f,c@i] + L[(E^-Subscript[b, i]-1)/Subscript[b, i] f, \[Delta]a[i,j]] + L[(1-E^-Subscript[b, i])f,c@j],
L[f_,c@j] :> L[E^-Subscript[b, i] f, c@j]+L[(1-E^-Subscript[b, i])/Subscript[b, i] f, \[Delta]a[i,j]],
L[f_,c@k_] /; k!=i&&k!=j :> L[f,c@k],
L[f_,\[Delta]] :> L[f,\[Delta]],
L[f_,1] :> L[f,1] + L[(1-E^-Subscript[b, i])(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(j\)]]f\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(i\)]]f\)),c@j] + L[(E^-Subscript[b, i]-1)/Subscript[b, i] (\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(j\)]]f\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(i\)]]f\)),\[Delta]a[i,j]],
L[f_,\[Delta]a[k_,j]] /; DistinctQ[i,j,k] :> L[E^-Subscript[b, i] f,\[Delta]a[k,j]]+ L[Subscript[b, k]/Subscript[b, i] (1-E^-Subscript[b, i])f, \[Delta]a[i,j]],
L[1,a[j,k_]] /; DistinctQ[i,j,k] :> L[E^Subscript[b, i],a[j,k]] - L[(Subscript[b, j]+Subscript[b, i] (1+Subscript[b, j])-E^Subscript[b, i] (Subscript[b, i]+Subscript[b, j]))/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\),ca[k,i,j]] + L[Subscript[b, j]/Subscript[b, i] (1-E^Subscript[b, i]), a[i,k]] + L[(Sinh[Subscript[b, i]] Subscript[b, i]+(-1+Cosh[Subscript[b, i]]) Subscript[b, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(2\)]\),ca[j,i,k]] + L[(Subscript[b, i] (-1+Cosh[Subscript[b, i]]-Subscript[b, j])+Sinh[Subscript[b, i]] Subscript[b, j])/
\!\(\*SubsuperscriptBox[\(b\), \(i\), \(3\)]\),\[Delta]a[i,j,i,k]],
L[f_,\[Delta]a[j,k_]] /; DistinctQ[i,j,k] :> L[E^Subscript[b, i] f, \[Delta]a[j,k]]+L[Subscript[b, j]/Subscript[b, i] (1-E^Subscript[b, i])f, \[Delta]a[i,k]],
L[f_,\[Delta]a[k_,i]] /; DistinctQ[i,j,k]:> L[f,\[Delta]a[k,i]] + L[(1-E^-Subscript[b, i])f,\[Delta]a[k,j]] + L[Subscript[b, k]/Subscript[b, i] (E^-Subscript[b, i]-1)f, \[Delta]a[i,j]],
L[f_,\[Delta]a[j,i]] :> L[E^Subscript[b, i] f,\[Delta]a[j,i]] + L[Subscript[b, j]/Subscript[b, i] (1-E^Subscript[b, i])f,\[Delta]a[i,j]],
L[1,a[i,k_]] :> L[1,a[i,k]] + L[1,ca[k,i,j]] + L[(E^-Subscript[b, i]-1)/Subscript[b, i],ca[j,i,k]] + L[(1-Subscript[b, i]-E^-Subscript[b, i])/Subscript[b, i]^2,\[Delta]a[i,j,i,k]],
L[f_,\[Delta]a[i,k_]] :> L[f,\[Delta]a[i,k]],
L[f_,a[k_,l_]] /; DistinctQ[i,j,k,l] :> L[f, a[k,l]],
L[f_,\[Delta]a[k_,l_]] /; DistinctQ[i,j,k,l] :> L[f, \[Delta]a[k,l]],
L[f_,ca[k_,l_,m_]] :> (L[f,c[k]]//Ad[a[i,j]])**((L[1,\[Delta]a[l,m]]//Ad[a[i,j]]) /. \[Delta]a->a),
L[f_,\[Delta]a[k_,l_,m_,n_]] :> (L[f,\[Delta]a[k,l]]//Ad[a[i,j]])**((L[1,\[Delta]a[m,n]]//Ad[a[i,j]]) /. \[Delta]a->a),
L[f_,g_] /; (f=!=1) && (g=!=1) :> (L[f,1]//Ad[a[i,j]])**(L[1,g]//Ad[a[i,j]]),
L[f_,g_] -> TBD[a[i,j],f,g]
}]


R[i_,j_] := Ad[a[i,j]]


Verify[expr_] := Module[{lhs,rhs}, {
lhs = expr // R[1,2] // R[1,3] // R[2,3] // LSimp,
rhs = expr // R[2,3] // R[1,3] // R[1,2] // LSimp,
LSimp[lhs-rhs]==0
}]



