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



DistinctQ[is___] := (Sort[{is}]===Union[{is}]);


a[0,__] := 0;
a /: a[f_,is__] + a[g_, is__] := a[f+g, is];
a /: -a[f_, is__] := a[Expand[-f], is];
\[Gamma][0,__] :=0;
\[Gamma] /: \[Gamma][f_,is__] + \[Gamma][g_, is__] := \[Gamma][f+g, is];
\[Gamma] /: -\[Gamma][f_, is__] := \[Gamma][Expand[-f], is];
\[Gamma]a[0,__] :=0;
\[Gamma]a /: \[Gamma]a[f_,is__] + \[Gamma]a[g_, is__] := \[Gamma]a[f+g, is];
\[Gamma]a /: -\[Gamma]a[f_, is__] := \[Gamma]a[Expand[-f], is];


\[Gamma][f_,j_,k_,k_] = 0;
\[Gamma][f_,j_,k_,l_] /; OrderedQ[{l,k}]\[And]DistinctQ[k,l] := \[Gamma][-f, j, l, k];


B[0,_] =0; B[_, 0] = 0;
B[x_,x_] = 0;
B[x_Plus, y_] := B[#,y]& /@ x;
B[x_, y_Plus] := B[x,#]& /@ y;


B[a[f_, j_,k_], a[g_, l_,m_]] := Plus[
B[a[j,k], a[l,m]] /. {a[h_,is__] :> a[Expand[f g h], is], \[Gamma][h_,is__] :> \[Gamma][Expand[f g h], is]},
\[Gamma]a[Expand[f(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(j\)]]g\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(k\)]]g\))], j,k,l,m] + \[Gamma]a[Expand[g(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(m\)]]f\)-\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(b\), \(l\)]]f\))], j,k,l,m]
];
(* tt *) B[a[j_,k_], a[j_,l_]] /; DistinctQ[j,k,l] := \[Gamma][1,j,k,l];
(* hh *) B[a[j_,k_], a[i_,k_]] /; DistinctQ[i,j,k] := a[Subscript[b, i], j,k] - a[Subscript[b, j], i,k];
(* th *) B[a[j_,k_], a[i_,j_]] /; DistinctQ[i,j,k] := a[Subscript[b, j], i,k] - a[Subscript[b, i], j,k] + \[Gamma][1, i,j,k];
(* ht *) B[a[j_,k_], a[k_,l_]] /; DistinctQ[j,k,l] := -B[a[k,l], a[j,k]];
(* loc *) B[a[j_,k_], a[l_,m_]] /; DistinctQ[j,k,l,m] := 0;


B[\[Gamma][f_, i_,j_], a[g_, k_,l_]] := -B[a[g, k,l], \[Gamma][f, i,j]];
(* tt\[Gamma] *) B[a[f_, j_,k_], \[Gamma][g_, j_,l_]] /; DistinctQ[j,k,l] := 0;
(* hh\[Gamma] *) B[a[f_, j_,k_], \[Gamma][g_, i_,k_]] /; DistinctQ[i,j,k] := - \[Gamma][Subscript[b, j]f g, i,k];
(* th\[Gamma] *) B[a[f_, j_,k_], \[Gamma][g_, i_,j_]] /; DistinctQ[i,j,k] := \[Gamma][Subscript[b, j]f g, i,k];
(* ht\[Gamma] *) B[a[f_, j_,k_], \[Gamma][g_, k_,l_]] /; DistinctQ[j,k,l] := \[Gamma][Subscript[b, j]f g, k,l] - \[Gamma][Subscript[b, j]f g, j,l];
(* loc\[Gamma] *) B[a[f_, j_,k_], \[Gamma][g_, l_,m_]] /; DistinctQ[j,k,l,m] := 0;
B[a[f_, j_,k_], \[Gamma][g_, j_,k_]] :=  \[Gamma][-Subscript[b, j]f g, j,k];


(* tt\[Gamma]3 *) B[a[f_, j_,k_], \[Gamma][g_, j_,l_,m_]] /; DistinctQ[j,k,l,m] := 0;
(* th\[Gamma]3-1 *) B[a[f_, j_,k_], \[Gamma][g_, i_,j_,l_]] /; DistinctQ[i,j,k,l] := \[Gamma][Subscript[b, j]f g,i,k,l] + \[Gamma]a[f g,i,l,j,k];
(* th\[Gamma]3-2 *) B[a[f_, l_,k_], \[Gamma][g_, i_,j_,l_]] /; DistinctQ[i,j,k,l] := \[Gamma][-Subscript[b, l]f g,i,k,j] + \[Gamma]a[-f g,i,j,l,k];
(* ht\[Gamma]3 *) B[a[f_, j_,k_], \[Gamma][g_, k_,l_,m_]] /; DistinctQ[j,k,l,m] := \[Gamma][-Subscript[b, k]f g,j,l,m] + \[Gamma][Subscript[b, j]f g,k,l,m];
(* hh\[Gamma]3-1 *) B[a[f_, j_,k_], \[Gamma][g_, n_,i_,k_]] /; DistinctQ[n,i,j,k] := \[Gamma][-Subscript[b, j]f g, n,i,k] + \[Gamma]a[f g, n,i,j,k];
(* hh\[Gamma]3-2 *) B[a[f_, j_,i_], \[Gamma][g_, n_,i_,k_]] /; DistinctQ[n,i,j,k] := \[Gamma][Subscript[b, j]f g, n,k,i] + \[Gamma]a[-f g, n,k,j,i];
(* a-th-1 *) B[a[f_, j_,k_], \[Gamma][g_, j_,k_,l_]] /; DistinctQ[j,k,l] := \[Gamma]a[-f g,j,k,j,l];
(* a-th-2 *) B[a[f_, j_,l_], \[Gamma][g_, j_,k_,l_]] /; DistinctQ[j,k,l] := \[Gamma]a[f g,j,l,j,k];
(* a-hh-1 *) B[a[f_, j_,k_], \[Gamma][g_, i_,j_,k_]] /; DistinctQ[i,j,k] := \[Gamma][-Subscript[b, j]f g, i,j,k] + \[Gamma]a[f g, i,j,j,k] + \[Gamma]a[f g, i,k,j,k];
(* a-hh-2 *) B[a[f_, k_,j_], \[Gamma][g_, i_,j_,k_]] /; DistinctQ[i,j,k] := \[Gamma][Subscript[b, k]f g, i,k,j] + \[Gamma]a[-f g, i,k,k,j] + \[Gamma]a[-f g, i,j,k,j];


B[_\[Gamma], _\[Gamma]] := 0;


ca[0,__] :=0;
ca /: ca[f_,is__] + ca[g_, is__] := ca[f+g, is];
ca /: -ca[f_, is__] := ca[Expand[-f], is];
B[a[f_,j_,k_], c[l_]] /; DistinctQ[j,k,l]:= 0;
B[a[f_,j_,k_], c[j_]] := \[Gamma][-f,j,k];
B[a[f_,j_,k_], c[k_]] := \[Gamma][f,j,k];
B[x_, ca[f_, i_,j_,k_]] := Plus[
B[x, c[i]] /. \[Gamma][g_,l_,m_] :> \[Gamma]a[f g, l,m,j,k],
B[x, a[f,j,k]] /. {a[g_,l_,m_] :> ca[g, i,l,m], _\[Gamma] -> 0, _\[Gamma]a -> 0}
];
\[Delta]aa[f_, i_,j_,k_,l_] /; OrderedQ[{l,j}]\[And]DistinctQ[i,j,k,l] := \[Delta]aa[f, k,l,i,j];
\[Delta]aa[f_, i_,j_,i_,l_] /; OrderedQ[{l,j}]\[And]DistinctQ[j,l]:= \[Delta]aa[f,i,l,i,j];
(* missing a 4T! *)
E\[Gamma] = {
\[Gamma][f_,j_,k_,l_] :> ca[f, l,j,k]+ca[Expand[-f], k,j,l],
\[Gamma]a[f_, i_,j_,k_,l_] :> \[Delta]aa[f, i,j,k,l] + ca[Expand[-Subscript[b, i]f], j,k,l]
};
Check3[y_\[Gamma]] := {t1=B[a[f,j,k], y] /. E\[Gamma], t2=B[a[f,j,k], y /. E\[Gamma]] /. E\[Gamma], t1==t2 // Simplify}



