(*========================= FILE: Tracer-1.1.1.m =========================*)
(*                                                                        *)
(*                              Last Change:                              *)
(*                      Mon Dec 30 15:36:00 MET 1991                      *)
(*                                                                        *)
(*                             "T R A C E R"                              *)
(*                        A MATHEMATICA PACKAGE FOR                       *)
(*                 GAMMA-ALGEBRA IN ARBITRARY DIMENSIONS                  *)
(*                   (based on MATHEMATICA Version 1.2)                   *)
(*                                                                        *)
(*    Authors: Matthias Jamin and Markus E. Lautenbacher,                 *)
(*             Physics Department, Theoretical Physics T31,               *)
(*             Technical University Munich,                               *)
(*             D-8046 Garching, FRG.                                      *)
(*             INTERNET-email:                                            *)
(*                 jamin@feynman.t30.physik.tu-muenchen.de                *)
(*                lauten@feynman.t30.physik.tu-muenchen.de                *)
(*                                                                        *)
(*             Bug reports (hopefully few) and suggestions welcome !      *)
(*                                                                        *)
(* References: M. Veltman, Nucl.Phys. B319(89), 253;                      *)
(*             P. Breitenlohner, D. Maison, Comm.Math.Phys. 52(77), 11;   *)
(*             G. Rufa, Annalen der Physik 47(90), 6.                     *)
(*                                                                        *)
(*========================================================================*)
 
(**************************************************************************)
(*                                                                        *)
(*                 COPYRIGHT AND DISCLAIMER OF WARRANTY                   *)
(*                                                                        *)
(*     Copyright (C) 1991 Markus E. Lautenbacher and Matthias Jamin.      *)
(*     This file is part of the TRACER package based on MATHEMATICA       *)
(*     version 1.2.                                                       *)
(*                                                                        *)
(*     The TRACER package is distributed in the hope that it will be      *)
(*     useful, but WITHOUT ANY WARRANTY.  No author or distributor        *)
(*     accepts responsibility to anyone for the consequences of using     *)
(*     it or for whether it serves any particular purpose or works        *)
(*     at all, unless he says so in writing.                              *)
(*                                                                        *)
(*     Permission is granted for use and non-profit distribution of       *)
(*     this file providing that this notice be clearly maintained, but    *)
(*     the right to distribute this file for profit or as part of any     *)
(*     commercial product is specifically reserved for the authors.       *)
(*     The same permission and reservation applies to the formatted       *)
(*     document produced from this file.                                  *)
(*                                                                        *)
(*     If you find the TRACER package useful for doing research,          *)
(*     acknowledging the authors' work by proper reference to the         *)
(*     package would be appreciated.                                      *)
(*                                                                        *)
(*     Please do not change this file. If you have to, document the       *)
(*     changes you have made !                                            *)
(*                                                                        *)
(**************************************************************************)
 
(*------------------------ BEGIN CONTEXT TRACER --------------------------*)
 
BeginPackage[ "Tracer`" ];
 
 
(*---------------------- UNPROTECT SPECICAL SYMBOLS ----------------------*)
(*------------------------ AND MAKE "TABULA RASA" ------------------------*)
 
Unprotect[ AntiCommute, ContractEpsGamma, Eps, G, GammaTrace, G5, H,
           ListCommands, NoSpur, OnShell, OutputFormat, RemoveHatMomenta,
           RemoveNCM, S, Sigma, SortLine, Spur, T, ToDiracBasis,
           ToHatTilde, ToOtimes, ToUG5, U, VectorDimension, Version ];
 
Remove[ "Tracer`*", "Tracer`Private`*" ];
 
 
(*-------------------------- STATUS OF TRACER -----------------------------*)
 
Authors = "
Matthias Jamin and Markus E. Lautenbacher,\n
Physics Department, Theoretical Physics T31,\n
Technical University Munich,\n
D-8046 Garching, FRG.\n
INTERNET-email:  jamin@feynman.t30.physik.tu-muenchen.de\n
                lauten@feynman.t30.physik.tu-muenchen.de";
 
MathVersion   = "1.2";
TracerVersion = "1.1.1";
LastChange    = "Mon Dec 30 15:36:00 MET 1991";
(* if this list grows to long MATHEMATICA gets an error on start-up *)
MajorChanges = "
- Rules for NonCommutativeMultiply[] moved to the end of Tracer";
 
Commands = "The package defines the following commands:
\n\"AntiCommute\", \"ContractEpsGamma\", \"Eps\", \"G\",
\"GammaTrace\", \"G5\", \"H\",\n\"ListCommands\", \"NoSpur\",
\"OnShell\", \"OutputFormat\", \"RemoveHatMomenta\",\n
\"RemoveNCM\", \"S\", \"Sigma\", \"SortLine\", \"Spur\", \"T\",
\"ToDiracBasis\",\n\"ToHatTilde\", \"ToOtimes\", \"ToUG5\", \"U\",
\"VectorDimension\", \"Version\".
\n                                    Help on usage as usual per ?Name.\n";
 
 
(*--------------------------- STARTUP MESSAGE -----------------------------*)
 
Print[" \n                               T R A C E R"];
Print["                              =============\n \n"];
Print["     A MATHEMATICA PACKAGE FOR GAMMA-ALGEBRA IN ARBITRARY DIMENSIONS"]
Print["                     by M. Jamin and M.E. Lautenbacher"];
Print["              Physics Dept. T31, Technical University Munich\n \n"];
Print["             Version ", TracerVersion, " from ", LastChange];
Print["                    (based on MATHEMATICA Version ", MathVersion,
      ")\n \n"];
Print[ Commands ];
Print["DEFAULT SETTINGS ON STARTUP:
\n----------------------------" ];
 
 
(*------------------ SET UP SYMBOLS OF PACKAGE TO EXPORT -----------------*)
 
AntiCommute::usage =
"AntiCommute[flag]: Depending on flag (on/off) toggle the usage of an
(non-)anticommuting matrix gamma_5.
\nAntiCommute[]: Show the currently used type of G5.";
 
ContractEpsGamma::usage =
"ContractEpsGamma[expr] contracts index pairs appearing in \"expr\"
according to the formula
\n    eps_{mu nu la rho} gamma^rho =
\n    i gamma_5 (  g~_{mu nu} gamma~_la - g~_{mu la} gamma~_nu
\n               + g~_{nu la} gamma~_mu - gamma~_mu gamma~_nu gamma~_la ),
\n   where as usual the tilde symbol denotes 4-dimensional objects.";
 
Eps::usage =
"Eps[arg1,arg2,arg3,arg4] is the completely antisymmetric product of
the four arguments \"arg1-4\". Eps[] is multi-linear with respect to
a linear combination with scalar coefficients. Arguments of Eps[]
can be a mixture of Lorentz indices and momenta, e.g.
\"Eps[[p,{mu},q,{nu}]\" means \"Eps_{alpha mu beta nu} p^alpha q^beta\"
in a standard physics notation.";
 
G::usage = "G[l,exp1,...,expn] is a REDUCE-like shorthand for
GammaTrace[l,exp1,...,expn]. Type `?GammaTrace' for more information.";
 
GammaTrace::usage =
"GammaTrace[l,exp1,...,expn] calculates the trace of a string of gamma
matrices in arbitrary dimensions. The space-time dimension can be set with
\"VectorDimension[]\". The expi can be: Symbols ( e.g. \"p\", \"q\" ) which
denote vectors, brackets (e.g. \"{mu}\", \"{nu}\" ) which denote indices or
expressions like \"p+m U+a G5\" where U is the unit matrix, G5 is gamma5 and
m and a are scalar coefficients. Indices which occur in pairs are contracted
automatically. Different strings are distinguished by the line index l.";
 
G5::usage =
"G5 is the matrix gamma_5 in d dimensional Gamma algebra.";
 
H::usage =
"H@Symbol is the projection of the d dimensional object \"Symbol\" onto
(d-4) dimensions.
\nDisplay format: H@p --> p^";
 
ListCommands::usage = 
"ListCommands[] shows a list of the commands defined by the Tracer
package.";
 
NoSpur::usage =
"NoSpur[l1, ..., ln] removes the gamma lines \"l1\", ..., \"ln\" from
being traced.";
 
OnShell::usage =
"OnShell[flag, list1, ..., listn]: Depending on flag (on/off), the
on-shell declarations specified in the \"listi\" are enforced or
removed.\n
Example: OnShell[on, {p1,m^2}, {s1,p1,0}, {e,-1}] declares the
substitutions S[p1,p1]=m^2, S[s1,p1]=0, S[e,e]=-1.
\nOnShell[]: Show all currently active on-shell declarations.";
 
OutputFormat::usage = 
"OutputFormat[flag]: Depending on flag (texlike/subscript) toggle the output
format of the scalar product \"S[expr]\" between TeX-input-like and
subscripted style.
\nOutputFormat[]: Show the currently used output format for \"S[expr]\".
\nFor examples of the display formats see the help entry on \"S\".";
 
RemoveHatMomenta::usage = 
"RemoveHatMomenta[expr, p1, p2, ...] sets all \"d-4\" dimensional momenta
\"p1^\", \"p2^\", ... in \"expr\" equal to 0.";
 
RemoveNCM::usage =
"RemoveNCM[flag]: Depending on flag (on/off) toggle whether
NonCommutativeMultiply[] should be removed or kept if all gamma lines
are different.
\nRemoveNCM[]: Show current treatment of NonCommutativeMultiply[].";
 
S::usage =
"S[arg1,arg2] is the scalar product of the two arguments. S is
symmetric and bilinear with respect to a linear combination with scalar
coefficients.  Use of the Dot operator for the scalar product is
possible.
\nDisplay formats:
\n          Input:                       OutputFormat[flag]:
\n(explicit)      (shorthand)          texlike      subscript
\nS[p, q]         p.q           -->    p.q          p.q
\nS[p,{mu}]       p.{mu}        -->    p_{mu}       p
\n                                                   mu
\nS[{mu},{nu}]    {mu}.{nu}     -->    g_{mu nu}    g
\n                                                   mu nu";
 
Sigma::usage =
"\"Sigma[ l,p,q ]\" is a shorthand notation for
\"I/2(G[l,p,q]-G[l,q,p])\".  It is decomposed immediately into the
equivalent gamma matrix strings.  In the output of \"ToDiracBasis[]\"
this automatic decomposition is prevented by an internal application of
the Hold[] command invisible to the user.  Thus, to use any \"Sigma[]\"
stemming from the output of \"ToDiracBasis[]\" in further calculations
you first have to apply a \"Release[]\" on the output.";
 
SortLine::usage =
"SortLine[ expr, l, reflist ] sorts the product of gamma matrices on line
`l' in expression `expr' with respect to the reference list `reflist'. 
If `l' does not match exactly one gamma matrix line in expr, SortLine[]
returns \"expr\" unchanged.\n
Example: SortLine[ G[l1,p,{m},{n},q] G[l2,p,q], l1, {{m},p,{n},q}]\n
           --> ( 2 p_{m} G[l1,{n},q] - G[l1,{m},p,{n},q] ) G[l2,p,q]";
 
Spur::usage =
"Spur[l1, ..., ln]
adds the gamma-matrix lines with line indices \"l1\", ..., \"ln\" to
the set of lines to be traced.
\nSpur[] shows the currently used gamma lines which should be traced.";
 
T::usage =
"T@Symbol is the projection of the d dimensional object \"Symbol\" onto
4 dimensions.
\nDisplay format: T@p --> p~";
 
ToDiracBasis::usage =
"\"ToDiracBasis[expr]\" decomposes an expression containing strings
\"G[...]\" of gamma matrices into the basis spanned by \"1\", \"g_5\",
\"g_mu\", \"g_mu g_5\" and \"I/2 [g_mu,g_nu]\" for all fermion lines
appearing in \"expr\". Since this basis is valid for space-time
dimensions equal to \"4\" only, the routine tests whether
\"VectorDimension[4]\" has been set and if not issues a warning
and exits.\n
\"ToDiracBasis[expr,{l1,l2,...}]\" decomposes only fermion lines
\"l1\", \"l2\", ... in \"expr\".\n
In the output of \"ToDiracBasis[]\" the automatic decomposition of
\"Sigma[]\" to gamma strings is prevented by an internal application of
the Hold[] command invisible to the user.  Thus, to use any \"Sigma[]\"
stemming from the output of \"ToDiracBasis[]\" in further calculations
you first have to apply a \"Release[]\" on the output.\n
Note that applying \"ExpandAll[]\" on expressions containing held
\"Sigma[]\" terms leads to weird output. Use commands
\"ExpandNumerator[]\" and \"ExpandDenominator[]\" instead.";
 
ToHatTilde::usage = 
"ToHatTilde[expr] decomposes \"d\" dimensional gamma algebra objects
according to the formula \"gamma_mu = gamma~_mu + gamma^_mu\" into
\"4\" and \"d-4\" dimensional objects, respectively. \"4\" dimensional
objects which's default redecomposition into \"d\" and \"d-4\" ones is
delayed via the \"Hold[T[]]\" command are displayed with parentheses
around them, e.g. \"Hold[T@{mu}]\" --> \"({mu}~)\". To go back to the
\"d\" and \"d-4\" objects just do a \"Release[]\" on the expression
containing \"4\" dimensional objects.\n
Note that applying \"ExpandAll[]\" on expressions containing terms like
\"Hold[T@{mu}]\" leads to weird output. Use commands
\"ExpandNumerator[]\" and \"ExpandDenominator[]\" instead.";
 
ToOtimes::usage =
"\"ToOtimes[expr]\" transforms all products of the form
Times[G[...],G[...],\n ...]\" to \"Otimes[G[...],G[...],...]\"
preserving the order of the \"G[...]\"'s. It is most usefully used as
\"expr // ToOtimes // TeXForm\" acting as a filter to give output of
\"expr\" in \"TeXForm\" with the \"\\otimes\" symbol between
\"G[...]\"'s stemming from different lines. Note that
\"ToOtimes[expr]\" is needed in \"G[...] G[...] // TeXForm\" but not in
\"G[...]**G[...] // TeXForm\" since the built-in \"TeXForm\" of \"**\"
is already \"\\otimes\".";
 
ToUG5::usage =
"ToUG5[expr] decompos all matching fermion lines appearing in \"expr\"
according to the formula
\n    a G[l,strg1,strg2] + b G[l,strg1,G5,strg2] =
\n    (a+b)/2 G[l,strg1,U+G5,strg2] + (a-b)/2 G[l,strg1,U-G5,strg2],
\n   with a!=0 && b!=0.\n
ToUG5[expr,{l1,l2,...}] decomposes only fermion lines \"l1\", \"l2\",
etc.. in \"expr\" into \"1 -+ gamma_5\" terms.";
 
U::usage = 
"U is the d dimensional unit matrix. For instance U is used in 
connection with mass terms as \"G[l, p+m U]\".";
 
VectorDimension::usage =
"VectorDimension[expr]: Set the space-time dimension to \"expr\". The
default symbol for the dimension is \"Global`d\". Do not use the symbol
\"D\" for the dimension since this may mix up with the differential
operator \"System`D\".
 
\nVectorDimension[]: Show the currently used expression for the space-time 
dimension.";
 
Version::usage = 
"Version[] prints out some information on the current version of the
TRACER package.";
 
 
(*------------------ BEGIN PRIVATE CONTEXT OF PACKAGE --------------------*)
 
Begin[ "`Private`" ];                   (* Hide actual code from the user *)
 
 
(*--------------------- PRINT INFO ON CURRENT VERSION  -------------------*)
 
ListCommands[] := ( Print[]; Print[ Commands ] );
 
Version[] :=
   (
     Print[];
     Print["AUTHORS: ", Authors];
     Print[];
     Print["VERSION:       ", TracerVersion, " based on Mathematica ", 
           MathVersion]; 
     Print["LAST CHANGE:   ", LastChange];
     Print["MAJOR CHANGES:"];
     Print[MajorChanges]
   );
 
 
(*--------------------------- OUTPUT FORMATS -----------------------------*)
 
(* Hat and tilde forms *)
 
Format[H[p_]] := StringJoin[ ToString[p], "^" ];
 
Format[T[p_]] := StringJoin[ ToString[p], "~" ];
 
(* Scalar product S[p,q] or p.q *)
 
StoString[p_,q_]:=                          (*  also used by OnShell  *)
  If[ TeXlike,
   Switch[ Head[p] Head[q],
               List List, StringJoin[ "g_{", ToString[p[[1]]], " ",
                                      ToString[q[[1]]], "}" ],
             Symbol List, StringJoin[ ToString[p], "_",  ToString[q] ],
               Hold Hold, Switch[ Head[p[[1,1]]] Head[q[[1,1]]],
                            List List, StringJoin["(g~_{",ToString[p[[1,1,1]]],
                                          " ", ToString[q[[1,1,1]]], "})" ],
                          Symbol List, StringJoin[ "(", ToString[p[[1,1]]],
                                                "~_", ToString[q[[1,1]]],")" ],
                                    _, StringJoin[ "(", ToString[p[[1,1]]],
                                               "~.", ToString[q[[1,1]]], "~)" ]
                              ],
                         _, StringJoin[ ToString[p], ".", ToString[q] ]
           ],
   Switch[ Head[p] Head[q],
               List List, Subscripted[ "g"[ p[[1]] q[[1]] ] ],
             Symbol List, Subscripted[ ToString[p][ q[[1]] ] ],
               Hold Hold, Switch[ Head[p[[1,1]]] Head[q[[1,1]]],
                            List List,
                                 Subscripted[ "(g~)"[p[[1,1,1]] q[[1,1,1]]] ],
                          Symbol List, Subscripted[ StringJoin[ "(",
                                 ToString[p[[1,1]]], "~)"][ q[[1,1,1]] ] ],
                                    _, StringJoin[ "(", ToString[p[[1,1]]],
                                               "~.", ToString[q[[1,1]]], "~)" ]
                              ],
                       _, StringJoin[ ToString[p], ".", ToString[q] ]
           ]
    ];
 
Format[S[p_,q_]] := StoString[p,q];
 
Format[H[p_,q_]]:= 
  If[ TeXlike,
   Switch[ Head[p] Head[q],
             List List, StringJoin[ "g^_{", ToString[p[[1]]], " ",
                                      ToString[q[[1]]], "}" ],
           Symbol List, StringJoin[ ToString[p],"^_",ToString[q] ],
                     _, StringJoin[ ToString[p],"^.",ToString[q],"^" ]
           ],
   Switch[ Head[p] Head[q],
               List List, Subscripted[ "g^"[ p[[1]] q[[1]] ] ],
             Symbol List, Subscripted[ StringJoin[ ToString[p], "^" ]
                                       [ q[[1]] ] ],
                     _, StringJoin[ ToString[p],"^.",ToString[q],"^" ]
           ]
    ];
 
(* Eps-tensor as Eps_{p1,p2,p3,p4} *)
 
Format[eps[{ p1_,p2_,p3_,p4_ }]]:=
   StringJoin[ "Eps[", ToString[p1], ",", ToString[p2],
                     ",", ToString[p3], ",", ToString[p4], "]" ];
 
(* Unevaluated parts of tr[l,{list}] *)
 
Format[tr[l_,{} ]] := StringJoin[ "U[ ", ToString[ l ], " ]" ];
 
Format[tr[l_,{ a__ } ]] :=
  Block[ {i, string = StringJoin[ "G[ ", ToString[ l ] ]},
          Do[
             Switch[ Head[ {a}[[i]] ],
                     List, string = StringJoin[ string, ", {",
                                       ToString[ {a}[[i,1]] ], "}" ],
                     Hold, string = StringJoin[ string, ", (",
                                       ToString[ {a}[[i,1]] ], ")" ],
                        _, string = StringJoin[ string, ", ", 
                                                ToString[ {a}[[i]] ] ]
                   ]
             ,{ i, Length[{a}] }
            ];
          string = StringJoin[ string, " ]" ];
          string
        ];
 
(* Format for sigma[l, Hold[]] produced by ToDiracBasis *)
 
Format[ sigma[l_, Hold[{m_,n_}]] ] :=
  StringJoin[ "Sigma[ ",ToString[l],",",ToString[m],",",ToString[n]," ]"];
 
 
(*------------ TeXForm FOR SCALAR PRODUCT AND EPSILON TENSOR  ------------*)
 
(* Symbols in (4-d) and 4 dimensions *)
 
Format[H[p_], TeXForm] := 
   Switch[ Head[p],
             List, StringJoin["\\hat\\gamma_{", ToString[TeXForm@p[[1]]],"}"],
             Symbol, StringJoin["\\not\\!\\hat ", ToString[TeXForm@p] ]
           ];
 
Format[T[p_], TeXForm] := 
   Switch[ Head[p],
             List, StringJoin["\\tilde\\gamma_{",ToString[TeXForm@p[[1]]],"}"],
             Symbol, StringJoin["\\not\\!\\tilde ", ToString[TeXForm@p] ]
           ];
 
(* Scalar product in d dimensions *)
 
Format[S[p_,q_], TeXForm]:= 
   Switch[ Head[p] Head[q],
               List List, StringJoin[ "g_{", ToString[TeXForm@p[[1]]], " ", 
                                      ToString[TeXForm@q[[1]]], "}" ],
             Symbol List, StringJoin[ ToString[TeXForm@p], "_{",  
                                      ToString[TeXForm@q[[1]]], "}" ],
                       _, If[ p === q,
                                StringJoin[ ToString[TeXForm[p]], "^{2}" ],
                                StringJoin[ ToString[TeXForm@p]," \\cdot ",  
                                        ToString[TeXForm@q] ]
                              ]
           ];
 
(* Scalar product in (4-d) dimensions *)
 
Format[H[p_,q_], TeXForm]:= 
   Switch[ Head[p] Head[q],
             List List, StringJoin[ "\\hat g_{", ToString[TeXForm@p[[1]]],
                                    ToString[TeXForm@q[[1]]], "}" ],
           Symbol List, StringJoin[ "\\hat ", ToString[TeXForm@p], "_{",  
                                    ToString[TeXForm@q[[1]]], "}" ], 
                     _, If[ p === q,
                              StringJoin["\\hat ",ToString[TeXForm[p]],"^{2}"],
                              StringJoin[ "\\hat ", ToString[TeXForm@p], 
                                 " \\cdot \\hat ", ToString[TeXForm@q] ]
                          ]
           ];
 
(* Epsilon tensor *)
 
Format[eps[{p1_,p2_,p3_,p4_}], TeXForm]:=
   StringJoin[ "\\epsilon\\left(", 
                 ToString[TeXForm@p1], ",", ToString[TeXForm@p2], ",", 
                 ToString[TeXForm@p3], ",", ToString[TeXForm@p4],
                 "\\right)" 
               ];
 
(* Unevaluated parts of tr[l,{list}]; the "Plus" in Switch is needed
   for "ToUG5 *)
 
Format[ G5, TeXForm ] = "\\gamma_{5}";
 
Format[ U, TeXForm] = 1;
 
Format[tr[l_,{} ], TeXForm] = 1;
 
Format[tr[l_,{ a__ } ], TeXForm] :=
  Block[ {i, TeXstring=""},
            Do[
               Switch[ {a}[[i]],
                  _List, TeXstring = StringJoin[ TeXstring, " \\gamma_{",
                                        ToString[TeXForm@{a}[[i,1]]],"} "],
   Hold[T[_List]], TeXstring = StringJoin[ TeXstring, " \\tilde\\gamma_{",
                                        ToString[TeXForm@{a}[[i,1,1,1]]],"} "],
 Hold[T[_Symbol]], TeXstring = StringJoin[ TeXstring, " \\tilde{\\not\\! ",
                                        ToString[TeXForm@{a}[[i,1,1]]],"} "],
                _Symbol, TeXstring = StringJoin[ TeXstring,
                                       If[ {a}[[i]]===G5 || {a}[[i]]===U,
                                           "", " \\not\\! "],
                                        ToString[TeXForm@{a}[[i]]]," "],
                  _Plus, TeXstring =
                         StringJoin[ TeXstring, " ",
                                     Switch[ { {a}[[i,1]],{a}[[i,2]] },
                                             { G5,U}, "(1+\\gamma_{5})",
                                             {-G5,U}, "(1-\\gamma_{5})",
                                             _, ToString[TeXForm@{a}[[i]]]
                                           ], " "
                                   ],
                      _, TeXstring = StringJoin[ TeXstring, " ",
                                        ToString[TeXForm@{a}[[i]]]," "] ],
               { i, Length[{a}] }
              ];
            TeXstring
          ];
 
 
(* Format for sigma[l, Hold[]] produced by ToDiracBasis *)
 
Format[ sigma[l_, Hold[{m_,n_}]], TeXForm ] :=
  Switch[ Head[m] Head[n],
            List List, StringJoin[ "\\sigma_{", ToString[TeXForm@m[[1]]],
                                 " ", ToString[TeXForm@n[[1]]], "}" ],
          Symbol List, StringJoin[ "{i\\over 2} [", ToString[TeXForm@m],
                           ",\\gamma_{", ToString[TeXForm@n[[1]]], "}]" ],
                    _, StringJoin[ "{i\\over 2} [", ToString[TeXForm@m],
                           ", ", ToString[TeXForm@n], "]" ]
        ];
 
 
(*------------------------------------------------------------------------*)
(*---------------------- BEGINNING Of THE MAIN RULES ---------------------*)
(*------------------------------------------------------------------------*)
 
(*--------------------- CONVERSION TO INTERNAL FORMAT --------------------*)
 
(* 
 * Convert user level functions G, GammaTrace, Eps, Sigma to internal
 * functions tr, eps, sigma. All actual calculations are done with tr,
 * eps and sigma. Gamma algebra objects are combined in a list.
 *)
 
G[line_, a___] := tr[line, {a}];                (* Synonym for GammaTrace *)
 
GammaTrace[line_, a___] := tr[line, {a}];
 
Sigma[l_,m_,n_] := sigma[l,{m,n}];
 
Eps[a_, b_, c_, d_] := eps[{a, b, c, d}];
 
 
(*-------------- USE DOT AS INPUT FOR THE SCALAR PRODUCT -----------------*)
 
Unprotect[ Dot ];
 
Dot[ a_, b_] := S[ a, b]   /;   ( !Length[a] > 1 || Head[a] === Plus ) &&
                                ( !Length[b] > 1 || Head[b] === Plus );
 
Protect[ Dot ];
 
 
(*------------------- TOGGLE USE OF ANTICOMMUTING G5 ---------------------*)
(* 
 * The rules anticommute G5 to the right and in case use {G5,G} = 2 G^ G5.
 * "G5flag" allows for control over the usage of the rules in "SortLine" 
 * and "ToUG5".    
 *)
 
AntiCommute[ flag_:query ] := 
   ( Switch[ flag,
          Tracer`on, 
             ( tr[l_,{a___,G5,b_,c___}] := -tr[l,{a,b,G5,c}] /; G5flag;
               AntiComm := True ),
          Tracer`off, 
             ( Unprotect[H];
            H[__] := 0;
            H[__] =. ;
            Protect[H]; 
            tr[l_,{a___,G5,b_,c___}] := -tr[l,{a,b,G5,c}] +
               2 tr[l,{a,H@b,G5,c}] /; G5flag;
               AntiComm := False ) ];
     If[ AntiComm, 
           Print[ "Package uses the usual anticommuting G5 in \"", 
                  ToString[d], "\" dimensions." ],
           Print[ "Package uses a non anticommuting G5 in \"", ToString[d], 
                  "\" dimensions." ] ];
     If[ AntiComm && d =!= 4,
        Print[ StringJoin[ "WARNING: Use of the Epsilon tensor in d != 4 ",
             "dimensions with\n         anticommuting G5 is algebraically ",
             "inconsistent." ] ] ];
     G5flag := True
   );
 
 
(*----------------------- SET SPACE-TIME DIMENSION -----------------------*)
 
VectorDimension[ dim_:query ] :=
   Switch[ dim,
           query, Print[ "Current dimension is \"", ToString[d], "\"." ],
               4, ( Unprotect[ Release[protected] ];
                    d = 4; 
                    H[__] := 0;
                    protected = Protect[ H ];
                    Print["Dimension set to \"4\". NOTE: For this setting of",
                          " the dimension the" ];
                    AntiCommute[ on ]
                  ),
               _, ( Unprotect[ Release[protected] ]; 
                    d = dim;
                    H[__] := 0;   (* Avoid error msg on multiple calls. *)
                    H[__] =.;
                    protected = Switch[ Head[d], 
                                        Symbol, Protect[H, Release[d]],
                                             _, Protect[ H ]            ];
                    Print[ "Dimension set to \"", ToString[d], 
                           "\". Used type of G5 left unchanged." ]
                  )
           ];
 
d = Global`d;         (* Set default symbol for the space-time dimension *)
protected = Join[ {H}, Protect[Release[d]] ];
 
 
(*----------------- MODIFY TABLE OF LINES TO BE TRACED -------------------*)
 
CalcTable = {};             (* default for lookup table of lines to trace *)
 
(*
 * if Spur[] and NoSpur[] are modified, also see
 * for a possible modification in ToDiracBasis[]
 *)
 
Spur[lines___] := ( CalcTable = Union[CalcTable, {lines}]; SpurOut[] );
 
NoSpur[lines___] := ( CalcTable = Complement[CalcTable, {lines}]; 
                        SpurOut[] );
 
SpurOut[] := Block[ {i, string = "The gamma matrix line(s) \""},
               Do[ string = StringJoin[ string,
                            ToString[ CalcTable[[i]] ], ", " ],
                   {i, Length[ CalcTable ] - 1} ];
               string = StringJoin[ string, ToString[
                   CalcTable[[Length[CalcTable]]] ], "\" will be traced." ];
               If[ Length[CalcTable]==0, string =
                   "No gamma matrix line will be traced.", ];
               Print[ string ] ];
 
 
(*---------------- SET OUTPUT STYLE FOR GAMMATRACE[list] -----------------*)
 
OutputFormat[ flag_:query ] := 
   ( Switch[ flag,
               Global`texlike,   TeXlike := True;,
               Global`subscript, TeXlike := False; ];
     Print[ "Current OutputFormat is set to ",
              If[ TeXlike, "\"texlike\"", "\"subscript\"" ], "." ]
   );
 
 
(*------------ TOGGLE TREATMENT OF NONCOMMUTATIVEMULTIPLY ----------------*)
 
RemoveNCM[ flag_:query ] :=
   ( Switch[ flag,
             Tracer`on,   NCMflag = True;,
             Tracer`off,  NCMflag = False; ];
     Print[ "NonCommutativeMultiply will be ",
            If[ NCMflag, "removed.", "kept." ] ]
   );
 
NCMflag = False;
 
 
(*----------------------- REMOVAL OF ALL TILDE PARTS ---------------------*)
 
(* Implementation of G~ = G - G^ *)
 
tr[l_,{a___, T@b_, c___}] := tr[l,{a, b, c}] - tr[l,{a, H@b, c}];
 
 
(*------------- REDUCTION OF TERMS WITH ONLY 'p' AND 'G5' FACTORS --------*)
 
(* 
 * Initalize flag for U-+G5 expansion. "ApartUG5" is toggled later on by 
 * "ToUG5" to allow for collection of terms with "U-+G5" structure.
 *)
 
ApartUG5 := True;
 
tr[l_,{a___, 0, b___}] := 0;
 
tr[l_,{a___, m_. U, b___}] := m tr[l,{a, b}];
 
tr[l_,{a___, p_+m_. U,b___}] := tr[l,{a,p,b}] + m tr[l,{a,b}] /; ApartUG5;
 
tr[l_,{a___, m_ G5, b___}] := m tr[l,{a, G5, b}];
 
tr[l_,{a___,p_+m_. G5,b___}]:=tr[l,{a,p,b}]+m tr[l,{a,G5,b}] /; ApartUG5;
 
 
(*-------------- DECOMPOSE SIGMA MATRIX INTO GAMMA STRINGS ---------------*)
 
(* trivial stuff *)
sigma[l_,{0,n_}] = 0;
sigma[l_,{m_,0}] = 0;
 
sigma[l_,{m_,n_}] := I/2 tr[l,{m,n}] - I/2 tr[l,{n,m}];
 
 
(*-------------- TRACES WITH AN ODD NUMBER OF GAMMA-MATRICES -------------*)
 
tr[l_,{a___}] := 0 /; ( OddQ[Length[{a}]-Count[{a},G5]] && 
                                                        MemberQ[CalcTable,l] );
 
 
(*------------------- REDUCTION TO TERMS WITH ONLY ONE G5 ----------------*) 
 
tr[l_,{a___, G5, G5, b___}] := tr[l,{a, b}];
 
(* Use cyclicity of "tr" *)
 
tr[l_,{a___,G5,b__}] := tr[l,{b,a,G5}] /; ( !MemberQ[{a,b},G5] && 
                                                        MemberQ[CalcTable,l] );
 
 
(*----------------------- ANTICOMMUTING G5 AS DEFAULT --------------------*)
 
(* 
 * Anticommuting G5 can be toggled later with AntiCommute[on/off]. 
 * The rule MUST be stated here to place it at the proper position in the 
 * rule tables build up by Mathematica for "tr". One can NOT simply remove 
 * or reformulate it depending on "G5flag" since this would place it at
 * the wrong position (most likely at the end) in the rule tables.
 *)
 
tr[l_,{a___, G5, b_, c___}] := - tr[l,{a, b, G5, c}] /; G5flag;
 
 
(*-------------------- TRACES OF UP TO 4 GAMMA-MATRICES ------------------*)
 
(* 
 * Give some explict formulae for short traces to improve performance 
 * since long traces will be reduced to many ever shorter traces when 
 * anti/commuting gamma matrices.
 *)
 
tr[l_,{}] := 4  /;  MemberQ[CalcTable,l];
 
tr[l_,{G5}] := 0  /;  MemberQ[CalcTable,l];
 
tr[l_,{a_, b_, G5}] := 0  /;  MemberQ[CalcTable,l];
 
tr[l_,{a_, b_}] := 4 S[a,b]  /;  MemberQ[CalcTable,l];
 
tr[l_,{a_, b_, c_, e_, G5}] := 4I eps[{a, b, c, e}] /; MemberQ[CalcTable,l];
 
tr[l_,{a_, b_, c_, e_}] := 4 S[a,b] S[c,e] - 4 S[a,c] S[b,e] + 
                          4 S[a,e] S[b,c]  /;  MemberQ[CalcTable,l];
 
 
(*---------------- CONTRACTION OF GAMMA-MATRICES ON ONE LINE -------------*)
(*         See references listed in program head for more details.        *)
 
tr[l_,{a___,H@{mu_},b___,  {mu_},c___}] := tr[l,{a, H@{mu}, b, H@{mu}, c}];
tr[l_,{a___,  {mu_},b___,H@{mu_},c___}] := tr[l,{a, H@{mu}, b, H@{mu}, c}];
 
tr[l_,{a___, mu_, mu_, b___}] := Switch[ mu,
                                                  _List, d tr[l,{a, b}],
                                               H[_List], (d-4) tr[l,{a, b}],
                                                      _, S[mu,mu] tr[l,{a, b}]
                                       ];
 
tr[l_,{a___, mu_, b_, mu_, c___}] :=
   Switch[ mu,
           _List   , (2-d) tr[l,{a,b,c}],
           H[_List], (4-d) tr[l,{a,b,c}] + 2 tr[l,{a,H@b,c}],
                  _, 2 S[mu,b] tr[l,{a,mu,c}] - S[mu,mu] tr[l,{a,b,c}]
         ];
 
tr[l_,{a___, mu_, b_, c_, mu_, e___}] :=
   Switch[ mu,
       _List, 4 S[b,c] tr[l,{a, e}] + (d-4) tr[l,{a, b, c, e}],
    H[_List], (d-4) tr[l,{a,b,c,e}]-2 tr[l,{a,H@b,c,e}]+2 tr[l,{a,H@c,b,e}],
           _, S[mu,mu] tr[l,{a, b, c, e}] - 2 S[mu,b] tr[l,{a, mu, c, e}] +
              2 S[mu,c] tr[l,{a, mu, b, e}]
         ];
 
tr[l_,{a___, mu_, b_, c_, e_, mu_, f___}] :=
   Switch[ mu,
          _List, (4-d) tr[l,{a,b,c,e,f}] - 2 tr[l,{a, e, c, b, f}],
          H[_List], (4-d) tr[l,{a,b,c,e,f}] + 2 tr[l,{a,H@b,c,e,f}] -
                     2 tr[l,{a,H@c,b,e,f}] + 2 tr[l,{a,H@e,b,c,f}],
          _, 2 S[mu,b] tr[l,{a,mu,c,e,f}] - 2 S[mu,c] tr[l,{a,mu,b,e,f}] +
                   2 S[mu,e] tr[l,{a,mu,b,c,f}] - S[mu,mu] tr[l,{a,b,c,e,f}]
         ];
 
tr[l_,{a___, mu_, b__, mu_, c___}] := 
  Switch[ mu,
        _List, Expand[
                     (-1)^Length[{b}] ( (d-4) tr[l,{a,b,c}] +
                     2 tr[l,Flatten[ {{a},Join[Reverse[Drop[{b},3-Length[{b}]]],
                                  Drop[{b},3]], {c} }, 1] ] +
                     Block[ {i}, 
                           2 Sum[ (-1)^i tr[l, Flatten[ { {a}, Prepend[Drop[{b},
                                 {i}], {b}[[i]]], {c} },1 ] ],{i,4,Length[{b}]}
                                ] 
                          ] ) ],
       H[_List], Expand[
                     (-1)^Length[{b}] ( (d-4) tr[l,{a,b,c}] +
                     Block[ {i}, 
                           2 Sum[ (-1)^i tr[l, Flatten[ { {a}, Prepend[Drop[{b},
                                 {i}],H@{b}[[i]]],{c} },1 ] ],{i,1,Length[{b}]}
                                ] 
                          ] ) ],
               _, Expand[
                      (-1)^Length[{b}] ( S[mu,mu] tr[l,{a,b,c}] +
                      Block[ {i},
                            2 Sum[ (-1)^i S[mu, {b}[[i]] ] 
                                  tr[l,Flatten[{{a},mu,Drop[{b},{i}],{c}},1]],
                                      {i,1,Length[{b}]}
                                 ]
                           ] ) ]
          ];
 
 
(*------------------ TRACES OF MORE THAN 4 GAMMA-MATRICES ----------------*)
(*         See references listed in program head for more details.        *)
 
tr[l_,{a__, G5}] := Expand[
   Block[ {i}, Sum[(-1)^i S[{a}[[1]],{a}[[i]]] *
      tr[l,Append[Rest[Drop[{a},{i}]], G5]], {i,2,Length[{a}]} ] ] -
   I/6 eps[{{a}[[1]],{i1},{i2},{i3}}] tr[l,Join[Rest[{a}],{{i1},{i2},{i3}} 
   ]]]  /;  MemberQ[CalcTable,l];
 
tr[l_,{a__}] := Expand[
                      Block[ {i}, Sum[(-1)^i S[{a}[[1]],{a}[[i]]] *
                              tr[l,Rest[Drop[{a},{i}]]],{i,2,Length[{a}]} ] ] 
                     ]  /;  MemberQ[CalcTable,l];
 
 
(*----------- PROJECTION PROPERTIES OF HAT AND TILDE OPERATORS -----------*)
 
H[0] = 0;
H[ H[p__] ] := H[p];
 
tr /: a1___ tr[ l1_,{b1___, H@{mu_}, b2___}] a2___ *
            tr[ l2_,{c1___,   {mu_}, c2___}] a3___ :=
      a1 tr[ l1, {b1,H@{mu},b2}] a2 tr[ l2, {c1,H@{mu},c2}] a3;
 
tr /: a1___ tr[ l1_,{b1___,   {mu_}, b2___}] a2___ *
            tr[ l2_,{c1___, H@{mu_}, c2___}] a3___ :=
      a1 tr[ l1, {b1,H@{mu},b2}] a2 tr[ l2, {c1,H@{mu},c2}] a3;
 
tr /: a1___ ** tr[ l1_,{b1___, H@{mu_}, b2___}] ** a2___ **
               tr[ l2_,{c1___,   {mu_}, c2___}] ** a3___ :=
      a1 ** tr[ l1, {b1,H@{mu},b2}] ** a2 ** tr[ l2, {c1,H@{mu},c2}] ** a3;
 
tr /: a1___ ** tr[ l1_,{b1___,   {mu_}, b2___}] ** a2___ **
               tr[ l2_,{c1___, H@{mu_}, c2___}] ** a3___ :=
      a1 ** tr[ l1, {b1,H@{mu},b2}] ** a2 ** tr[ l2, {c1,H@{mu},c2}] ** a3;
 
T[0] = 0;
T[ T[p__] ] := T[p];
 
 
(*-------------------  LINEARITY OF THE SCALAR PRODUCT -------------------*)
 
Attributes[S] = {Orderless};
Attributes[H] = {Orderless};
Attributes[T] = {Orderless};
 
S[0,p_] = 0;
S[  a_,H@b_] := H[a,b];
S[H@a_,H@b_] := H[a,b];
S[  a_,T@b_] := S[a,b] - H[a,b];
S[T@a_,T@b_] := S[a,b] - H[a,b];
 
H[0,p_]    = 0;
H[T@_,___] = 0;
H[  a_,H@b_] := H[a,b];
H[H@a_,H@b_] := H[a,b];
 
T[H@_,___] = 0;
T[ a_, b_] := S[ a, b] - H[ a, b];
 
S[c_?NumberQ p_, q_]    := c S[p,q];
S[p_, {c_?NumberQ q_} ] := c S[p,{q}];
 
S[p_ + q_, r_] := S[p,r] + S[q,r];
 
 
(*----------------- CONTRACTION RULES FOR THE SCALAR PRODUCT -------------*)
 
(* 
 * Reduce "p.p" type expressions to a real quadrad of p. 
 * S[p_Symbol,p_] := p^2
 *)
 
S[{mu_},{mu_}] := d;
H[{mu_},{mu_}] := d-4;
 
S /: S[{mu_},p_]^2 := S[p,p];
H /: H[{mu_},p_]^2 := H[p,p];
 
S /: S[{mu_},p_] tr[l_, { a___,{mu_},b___ }] := tr[l, { a,  p,b }];
H /: H[{mu_},p_] tr[l_, { a___,{mu_},b___ }] := tr[l, { a,H@p,b }];
 
S /: S[{mu_},p_] tr[l_, { a___,H@{mu_},b___ }] := tr[l, { a,H@p,b }]; 
H /: H[{mu_},p_] tr[l_, { a___,H@{mu_},b___ }] := tr[l, { a,H@p,b }];
 
S /: S[{mu_},p_] e___ ** tr[l_, { a___,{mu_},b___ }] ** f___ :=
     e ** tr[l, { a,  p,b }] ** f;
H /: H[{mu_},p_] e___ ** tr[l_, { a___,{mu_},b___ }] ** f___ :=
     e ** tr[l, { a,H@p,b }] ** f;
 
S /: S[{mu_},p_] e___ ** tr[l_, { a___,H@{mu_},b___ }] ** f___ :=
     e ** tr[l, { a,H@p,b }] ** f;
H /: H[{mu_},p_] e___ ** tr[l_, { a___,H@{mu_},b___ }] ** f___ :=
     e ** tr[l, { a,H@p,b }] ** f;
 
S /: S[{mu_},p_] f_[a___,{mu_},b___] := f[a,  p,b];
H /: H[{mu_},p_] f_[a___,{mu_},b___] := f[a,H@p,b];
 
S /: S[{mu_},p_] f_[a___,H@{mu_},b___] := f[a,H@p,b];
H /: H[{mu_},p_] f_[a___,H@{mu_},b___] := f[a,H@p,b];
 
S /: S[{mu_},p_] f_[{a___,{mu_},b___}] := f[{a,  p,b}];
H /: H[{mu_},p_] f_[{a___,{mu_},b___}] := f[{a,H@p,b}];
 
S /: S[{mu_},p_] f_[{a___,H@{mu_},b___}] := f[{a,H@p,b}];
H /: H[{mu_},p_] f_[{a___,H@{mu_},b___}] := f[{a,H@p,b}];
 
 
(*------------------------------ EPSILON-TENSOR --------------------------*)
 
eps[{___, 0, ___}] = 0;
 
eps[{___, H@p_, ___}] = 0;
 
(*
 * Below we have to use named patterns a___ and b___ because TRACER
 * knows already how to contract identical indices and would therefore
 * contract tr[l, {BlankNullSequence[], H@{mu_}, BlankNullSequence[]}]
 * in the following rule. Weird but consistent. As a workaround one
 * could move the rule further to the beginning of the code and tag on
 * "tr" but for performance reasons we prefere to tag on "eps".
 *)
eps /: eps[{___, {mu_}, ___}] tr[l_, {a___, H@{mu_}, b___}] = 0;
 
eps[list4_] := 0 /; Signature[list4]==0;
 
(* "OrderedQ" must be there to prevent an infinite loop. *)
 
eps[list4_] := Signature[list4] eps[Sort[list4]] /; OrderedQ[list4]==False;
 
eps[{a___, c_?NumberQ p_, b___}]   := c eps[{a, p, b}];
eps[{a___, {c_?NumberQ p_}, b___}] := c eps[{a , {p}, b}];
 
eps[{a___, p_+q_, b___}] := eps[{a, p, b}] + eps[{a, q, b}];
 
 
(* Once again, give some explict formulae to improve performance. *)
 
eps /: eps[{{la_},{mu_},{nu_},p1_}]^2 := 6 ( H[p1,p1] - S[p1,p1] );
 
eps /: eps[{{la_},{mu_},{nu_},p1_}] eps[{{la_},{mu_},{nu_},q1_}] :=
        6 ( H[p1,q1] - S[p1,q1] );
 
eps /: eps[{{mu_},{nu_},p1_,p2_}]^2 :=
        2 Expand[ - Det[{{S[p1,p1]-H[p1,p1],S[p1,p2]-H[p1,p2]},
                         {S[p2,p1]-H[p2,p1],S[p2,p2]-H[p2,p2]}}]];
 
eps /: eps[{{mu_},{nu_},p1_,p2_}] eps[{{mu_},{nu_},q1_,q2_}] :=
        2 Expand[ - Det[{{S[p1,q1]-H[p1,q1],S[p1,q2]-H[p1,q2]},
                         {S[p2,q1]-H[p2,q1],S[p2,q2]-H[p2,q2]}}]];
 
(* General formulae *)
 
eps /: eps[{p1_,p2_,p3_,p4_}]^2 := Expand[ - Det[{
 {S[p1,p1]-H[p1,p1],S[p1,p2]-H[p1,p2],S[p1,p3]-H[p1,p3],S[p1,p4]-H[p1,p4]},
 {S[p2,p1]-H[p2,p1],S[p2,p2]-H[p2,p2],S[p2,p3]-H[p2,p3],S[p2,p4]-H[p2,p4]},
 {S[p3,p1]-H[p3,p1],S[p3,p2]-H[p3,p2],S[p3,p3]-H[p3,p3],S[p3,p4]-H[p3,p4]},
 {S[p4,p1]-H[p4,p1],S[p4,p2]-H[p4,p2],S[p4,p3]-H[p4,p3],S[p4,p4]-H[p4,p4]}}]
 ];
 
eps /: eps[{p1_,p2_,p3_,p4_}] eps[{q1_,q2_,q3_,q4_}] := Expand[ - Det[{
 {S[p1,q1]-H[p1,q1],S[p1,q2]-H[p1,q2],S[p1,q3]-H[p1,q3],S[p1,q4]-H[p1,q4]},
 {S[p2,q1]-H[p2,q1],S[p2,q2]-H[p2,q2],S[p2,q3]-H[p2,q3],S[p2,q4]-H[p2,q4]},
 {S[p3,q1]-H[p3,q1],S[p3,q2]-H[p3,q2],S[p3,q3]-H[p3,q3],S[p3,q4]-H[p3,q4]},
 {S[p4,q1]-H[p4,q1],S[p4,q2]-H[p4,q2],S[p4,q3]-H[p4,q3],S[p4,q4]-H[p4,q4]}}]
 ];
 
(* decompose Eps[p1,p2,p3,p4] g_q1 g_q2 g_q3 for anticommuting G5 *)
 
eps /: eps[{p1_,p2_,p3_,p4_}] tr[l,{q1_,q2_,q3_}] :=
Block[ {m},
       (* unique auxiliary index to prevent unindended contractions *)
       m = Unique["idx"];  
       eps[{p1,p2,p3,p4}] ( S[q1,q2] tr[l,{q3}] + S[q2,q3] tr[l,{q1}] - 
       S[q1,q3] tr[l,{q2}] + I eps[{q1,q2,q3,{m}}] tr[l,{G5,{m}}] ) /; 
         G5flag && Length[Intersection[{p1,p2,p3,p4},{q1,q2,q3}]] >= 1
     ];
 
(* perform contraction for index pairs in eps_{...,{mu},...} g_mu *) 
 
(* The rhs of the rule below is a little bit complicated since we do not
   know where exactly in indices the generic index {mu_} appears. The 
   reason is that Eps[] automatically rearranges its arguments in
   canonical order e.g. Eps[a, b, {m}, c] G[l, {m}] would be reordered
   while Eps[a, b, {m}, {n}] G[l, {m}] would not. Thus the number of
   explicit rules taking into account all possible argument types /
   orderings would be tremendous. *)
 
ContractEpsGammaRule =
   eps[indices_List] tr[l_, {a___, {mu_}, b___}] :>
      Block[ {index, pos},
             pos   = Position[indices, {mu}][[1,1]];
             index = Drop[indices, {pos,pos}]; 
             (-1)^pos * (
             I tr[l, {a, T@index[[1]], T@index[[2]], T@index[[3]], G5, b}] -
             I T[index[[1]],index[[2]]] tr[l, {a, T@index[[3]], G5, b}] +
             I T[index[[1]],index[[3]]] tr[l, {a, T@index[[2]], G5, b}] -
             I T[index[[2]],index[[3]]] tr[l, {a, T@index[[1]], G5, b}]
             )
      ] /; ( Length[indices]==4 && MemberQ[indices, {mu}] );
 
ContractEpsGamma[expr_] := expr //. ContractEpsGammaRule // Expand;
 
 
(*-------------------------- ONSHELL DECLARATIONS ------------------------*)
 
lookup = {};             (* default lookup table for OnShell declarations *)
 
OnShell[ flag_:query, list___ ] := 
   Block[ { ni, i, l, l3 },
      l = { list };
      Switch[ flag,
          Tracer`on,
             ( Unprotect[ S ];
             For[i=1, i <= Length[l], i++,
                   ni=Length[ l[[i]] ];
                   Switch[ ni,
                   2, l3 = {l[[i,1]], l[[i,1]], l[[i,2]]}, 
                       3, l3 = l[[i]],
                       _, (Print[ "Illegal OnShell declaration: Probably",
                                 " too many/less elements in list ", l[[i]], "."];
                       Continue[]) ];
                       S[ l3[[1]],l3[[2]] ] = l3[[3]]; 
                         lookup = Union[lookup, {l3}]
                 ];
               Protect[ S ]
           ),
          Tracer`off,
           ( Unprotect[ S ];
             For[i=1, i <= Length[l], i++,
               ni=Length[ l[[i]] ];
               Switch[ ni,
                   2, l3 = {l[[i,1]], l[[i,1]], l[[i,2]]},
                   3, l3 = l[[i]],
                   _, (Print[ "Illegal OnShell declaration: Probably",
                         " too many/less elements in list ", l[[i]], "."];
                      Continue[]) ];
                   If[ MemberQ[lookup, l3],
                       ( S[ l3[[1]],l3[[2]] ] =. ;
                         lookup = Complement[lookup, {l3}] ),
                       Print["No such OnShell declaration: ",l[[i]]]
                     ]
             ];
             Protect[ S ]
           ),
          query, If[ Length[lookup] != 0, 
                     ( Print[ "Active OnShell declarations:" ];
                       Do[ Print[ StoString[lookup[[i,1]],lookup[[i,2]]],
                                  " = ", S[ lookup[[i,1]],lookup[[i,2]] ] ],
                           { i, Length[lookup] }
                         ] ), 
                       Print[ "No OnShell declarations are active." ]
                   ],
          _, Print["Illegal flag in OnShell."] ];
         ];
 
(*--------------- SORT GAMMA MATRICES ON LINES BY REFERENCE --------------*)
 
(* 
 * Sort "list" on line "l" in expression "expr" with reference to 
 * "reflist".
 * "recflag" controlls the usage of the "G5" rules during the recursive
 * calls to "SortLine" in "SortRules". During the reordering the
 * rules commuting "G5" to the right are disabled while at the end the
 * relevant rules are enabled again.
 *)
 
SortLine[ expr_, l_, reflist_List:{}, recflag_:query] := Block[
   { i, k, list, perm={}, out1=expr, out2, pos, rlist=reflist, slot, x },
   G5flag := False;
   pos = Position[ expr, tr[ l, {___}] ];
   (* if requested line not found return expr unsorted *)
   If[ pos == {}, Return[expr] ];
   Do[
        list = expr[[ pos[[i]] /. List[a___] -> a, 2 ]];
        If[ reflist == {},
            If[ MemberQ[ list, G5],
                rlist = Append[ Sort[ Drop[ list, {Where[list,G5]}] ], G5],
                rlist = Sort[list] ]
          ];
        If[ list === rlist, ,
            If[ Sort[list] === Sort[rlist],
                perm={};
                Do[ 
                    slot = Where[ list, rlist[[k]] ];
                    perm = Append[ perm, slot], {k, Length[list]}
                  ];
                out2 = tr[ l, list];
                Do[
                    x = list[[ perm[[k]] ]];
                    SetSortRules[ l, rlist, x, k ];
                    out2 = out2 //. SortRules
                    ,{ k, Length[perm] }
                  ];
                out1 = out1 /. tr[ l, list] -> out2 
              ]
          ], {i, Length[pos]}
     ];
   Return[ If[ recflag == query, G5flag := True] ; Expand[ out1 ] ] ];
 
(*
 * Utilities for "SortLine"
 *)
 
(* Where is "x" in "list" ? *)
 
Where[ list_List, x_] := First[ Sort[ Position[ list, x] ] ][[1]];
 
(* 
 * Set up the transformation rule for current list element "x" to be
 * moved to position "i" on line "l".
 *)
 
SetSortRules[ lidx_, rlist_, x_, k_] :=
(
 SortRules =
 Switch[  x,
          G5, tr[ lidx, {a___, b_, G5, c___} ] :>
              Switch[ Head[b],
                      H, tr[lidx, {a, G5, b, c}],
                      _, If[ AntiComm, -tr[lidx, {a, G5, b, c}], 
                         -tr[lidx, {a,G5,b,c}] + 2 tr[lidx, {a,G5,H@b,c}] ]
                    ] /; Where[{a,b,G5,c},G5] > k,
           _,
         {
           tr[ lidx, {a___, G5, x, c___} ] :> 
               Switch[ Head[x],
                       H,  tr[lidx, {a, x, G5, c}],
                       _,  If[ AntiComm, -tr[lidx, {a, x, G5, c}],
                           -tr[lidx, {a,x,G5,c}] + 2 tr[lidx, {a,H@x,G5,c}] ]
                     ] /; Where[{a,G5,x,c},x] > k
           ,
           tr[ lidx, {a___, b_, x, c___} ] :> -tr[ lidx,{a, x, b, c}] +
               2 S[b,x] SortLine[ tr[ lidx,{a,c} ], lidx, Drop[ Drop[ rlist,
               {Where[rlist,b]} ], {Where[rlist,x]} ], deep ]
               /; ( Where[{a,b,x,c},x] > k ) && Not[b===G5]
         }
        ];
  SortRules = Dispatch[ SortRules ]
);
 
 
(*------------ IMPROVE READABILITY BY COLLECTING 1-+G5 TERMS ------------*)
 
(*
 * "ToUG5" tries to transform terms of the form "g_mu +- g_mu g_5" 
 * to "g_mu ( 1 +- g_5 )".
 * Note that one can NOT transform this in a straightforward way to 
 * "tr[l,{{mu},U-+G5}]" since this would match an earlier pattern and
 * thus lead to an infinite loop. 
 * Therefore the appropriate rules for expansion of terms matching the
 * pattern "tr[l,{{mu},U-+G5}]" are controlled by the flag "ApartUG5".
 * This situation is analogous to "G5flag" in the function "SortLine".
 *)
 
(*
 * Rules for "1-+g_5" collection
 * Extracting numbers, symbols and combinations of both and combining
 * the rest needs a careful choice of the relevant rules. Especially 
 * the "Minus" sign in expressions like "g_mu - g_mu g_5" is a bit
 * tricky since it is stored internally as "Times[-1,g_mu]". Use 
 * "FullForm" to understand the Why's and How's of the rules.
 * The order of rules in "ToUG5" is absolutely crucial for proper 
 * operation of the "1+-g_5" collection.
 * E.g. with reversed rule order the expanded form of "G[l1,U-G5] *
 * G[l2,U-G5]" is only partially collected.
 *)
 
(*
 * Note the `dirty trick' concerning the "Return[...]" statement!
 * Setting "ApartUG5 := True" just before the "Return" and doing a
 * simple "Return[out]" would invoke an evaluation of "out" with the 
 * U-+G5 expansion already in use again. 
 * There is nothing about that in the manual but it seems to work. ;-)
 *)
 
GetAllLines[expr_] :=
  Block[ {lines={}, pos, l, i},
         pos = Position[expr, tr[___]];
         Do[
             l = expr[[ pos[[i]] /. List[a___] -> a, 1 ]];
             AppendTo[lines, l];
             , {i,1,Length[pos]}
           ];
         lines = Union[lines];
         lines
       ];
 
(*
 * We have to use "rule = ... :> ... //. {lidx -> l}" because otherwise
 * we won't get line indices "l" properly substituted with "lines[[i]]"
 * on the rhs of ":>".
 * Note: We have to write`m*1' because we use `m__' as pattern on 
 *       the lhs.
 *)
SetToUG5Rules[lines_] :=
  Block[ {lidx, l, i, rule},
         ToUG5Rules = {};
         Do[
             l = lines[[i]];
             rule=m__ tr[lidx,{a___,b___}]+n__ tr[lidx,{a___,G5,b___}]:>
                  (m*1+n*1) 1/2 tr[lidx,{a,U+G5,b}] + 
                  (m*1-n*1) 1/2 tr[lidx,{a,U-G5,b}];
             rule = rule //. {lidx -> l}; 
             AppendTo[ToUG5Rules, rule];
 
             rule=m_. tr[lidx,{a___,b___}]+n_. tr[lidx,{a___,G5,b___}]:>
                  (m+n) 1/2 tr[lidx,{a,U+G5,b}] + 
                  (m-n) 1/2 tr[lidx,{a,U-G5,b}];
             rule = rule //. {lidx -> l}; 
             AppendTo[ToUG5Rules, rule];
 
             rule= m__ (e___ ** tr[lidx,{a___,b___}   ] ** f___) +
                   n__ (e___ ** tr[lidx,{a___,G5,b___}] ** f___) :>
                  (m*1+n*1) 1/2 (e ** tr[lidx,{a,U+G5,b}] ** f) + 
                  (m*1-n*1) 1/2 (e ** tr[lidx,{a,U-G5,b}] ** f);
             rule = rule //. {lidx -> l}; 
             AppendTo[ToUG5Rules, rule];
 
             rule=m_. (e___ ** tr[lidx,{a___,b___}   ] ** f___) +
                  n_. (e___ ** tr[lidx,{a___,G5,b___}] ** f___) :>
                  (m+n) 1/2 (e ** tr[lidx,{a,U+G5,b}] ** f) + 
                  (m-n) 1/2 (e ** tr[lidx,{a,U-G5,b}] ** f);
             rule = rule //. {lidx -> l}; 
             AppendTo[ToUG5Rules, rule]
(*
 * Shall we include that ?
 *
 *            rule = tr[lidx,{a___,G5,b___}] :> 
 *                      1/2 tr[lidx,{a,U+G5,b}] + 1/2 tr[lidx,{a,U-G5,b}];
 *            rule = rule //. {lidx -> l}; 
 *            AppendTo[ToUG5Rules, rule]
 *)
             , {i,1,Length[lines]}
           ];
         ToUG5Rules = Dispatch[ToUG5Rules]
       ];
 
 
ToUG5[ expr_, lines_:{} ] := 
 Block[ {out, linelist=lines, pos, poslist, i},
           ApartUG5 := False;
           G5flag   := False;
        If[linelist == {}, linelist = GetAllLines[expr]];
        SetToUG5Rules[linelist];
           out = ExpandAll[ expr ] //. ToUG5Rules;
(* 
 * We have to do a MapAt[Release,...] here because the above ExpandAll
 * gets inside possible Hold[]'s in "out". There it would cause commands
 * like TeXForm[ToUG5[expr]] to produce garbage.
 *)
        poslist = Position[out, Hold[_]];
        Do[
             pos = poslist[[i]];
             (* argument of Hold[_] is one level deeper *)
             AppendTo[pos, 1];  
             out = MapAt[Release, out, pos];
             ,{i,Length[poslist]}
          ];
           Return[ApartUG5 := True; G5flag := True; out]
         ];
 
 
(*-------------- TeX FORMAT FOR `*' PRODUCT OF SEVERAL LINES  ------------*)
 
(*
 * Note that the ordering of rules in "OtimesRules" is crucial to give a 
 * one-to-one copy of the "G[...]*G[...]*..." order in "Otimes" and
 * therefore in the final TeX output.
 * Since Mathematica orders products of expressions of type "tr[l,{...}]" 
 * with respect to the first argument one can enforce a certain order of 
 * lines in "G[...]*G[...]*..." by naming line indices appropriately, 
 * e.g. "G[l1,...]*G[l2,...]*...".
 *)
 
OtimesRules = {
                 otimes[a__] b_tr :> otimes[ a,b ]
                 ,
                 a_tr b_tr        :> otimes[ a,b ]
               };
 
ToOtimes[ expr_ ] := expr //. OtimesRules;
 
 
Format[ otimes[a__], TeXForm ] := 
  Block[ { i,strg="" },
          Do[
               strg = StringJoin[ strg, ToString@TeXForm[{a}[[i]]], 
                                  " \\otimes " ];
             , {i,Length[{a}]-1}
            ];
          strg = StringJoin[ strg, ToString@TeXForm[{a}[[Length[{a}]]]] ]
        ];
 
(*------------------ DECOMPOSE STRINGS OF GAMMAS IN d=4  -----------------*)
 
(*
 * Decomposition of strings of gamma matrices into 1-, g_5-, g_mu-, 
 * g_mu g_5- and 1/2 [ g_mu,g_nu ]-terms in "4" space-time dimensions.
 * The decomposition is done with brute force by projecting the gamma 
 * string on the various basis terms.
 *)
 
ToDiracBasis[ expr_, lines_:{} ] := 
 Block[ {linelist=lines,poslist={},DecomposeRules={},FermionLine,i},
        (* get indices of lines to decompose *)
        If[linelist == {}, linelist = GetAllLines[expr]];
        (* where in expr are the fermion lines *)
        Do[ poslist = Join[ poslist,
                            Position[expr, tr[linelist[[i]], {___}]]
                          ];
            , {i, Length[linelist]}
          ];
        (* build list of rules to decompose each indiviual f. line *)
        Do[ FermionLine = expr[[ poslist[[i]] /. List[a___] -> a ]];
            AppendTo[ DecomposeRules,
                      FermionLine -> ToDiracBasisSingle[FermionLine]
                    ]
            , {i, Length[poslist]}
          ];
        (* replace each fermion line by its' decomposition *)
        expr //. DecomposeRules
      ];
 
(*
 * Note: We have to do the decomposition in a single final step with
 * "expr //. DecomposeRules" because line by line replacement would
 * leave the predetermined positions for later fermion lines invalid.
 *)
 
(*
 * Decomposition to {1, g_5, g_mu, g_mu g_5, sigma_{mu nu}} basis for a
 * single fermion line.
 *)
 
ToDiracBasisSingle[ expr_tr ] :=
   Block[ { list, l1, l2, m1, m2, out, AuxSigma },
          (* ensure decomposition to basis for d=4 only *)
          If[ d =!= 4, Return["Error: Use \"VectorDimension[4]\" first."] ];
          (* extract line and gamma string indices *)
          l1   = expr[[1]];
          list = expr[[2]];
          (* unique auxiliary indices to prevent unintended contractions *)
          l2   = Unique["ln"];  
          m1   = Unique["idx"];
          m2   = Unique["idx"];
          (* projections on complete basis for d=4 *)
          CalcTable = Union[CalcTable, {l2}];
          scalar  = 1/4 tr[ l2,list ];
          pscalar = 1/4 tr[ l2,Append[list,G5] ];
          vector  = 1/4 tr[ l2,Append[list,{m1}] ];
          pvector = 1/4 tr[ l2,Append[Append[list,G5],{m1}] ];
          tensor  = -I/8 (1/2 tr[ l2,Append[Append[list,{m2}],{m1}] ] -
                          1/2 tr[ l2,Append[Append[list,{m1}],{m2}] ] );
          (* free local line index l2 from being traced *)
          CalcTable = Complement[CalcTable, {l2}];
          out = ExpandAll[ scalar  tr[l1,{U}] +
                           pscalar tr[l1,{G5}] + 
                           vector  tr[l1,{{m1}}] +
                           pvector tr[l1,{{m1},G5}] + 
                           tensor  AuxSigma[l1,{{m1},{m2}}]
                         ];
          (* contract and order indices of the auxiliary sigma matrix *)
          out = out //. {
             S[{mu_},p_] AuxSigma[l_, { a___,{mu_},b___ }] :>
                AuxSigma[l, { a,  p,b }],
             S[{mu_},p_] AuxSigma[l_, { a___,H@{mu_},b___ }] :>
                AuxSigma[l, { a,H@p,b }],
             AuxSigma[l_,list_List] :> Signature[list] *
                AuxSigma[l,Sort[list]] /; OrderedQ[list]==False
          }; 
          out = out //. AuxSigma[l_,list_List] :> sigma[l,Hold[list]];
          (*
           * Memo: Usage of an intermediate AuxSigma[] allows argument
           * {{m1},{m2} to be evaluated, contractions and ordering to 
           * be done; the final sigma[l1,Hold[]] prevents the automatic
           * sigma decomposition.
           *)
          (* garbage collection: remove obsolete auxiliary indices *)
          Remove[ Release[l2] ];
          If[ FreeQ[out,Release[m1]], Remove[ Release[m1] ] ];
          If[ FreeQ[out,Release[m2]], Remove[ Release[m2] ] ];
          (* return the resulting decomposition *)
          out
        ];
 
(* 
 * It is not possible to do garbage collection with the statement
 * "Remove[ Release[l2], Release[m1], Release[m2] ];".
 * This would work if all indices "m1","m2" in the tr's of "out" would 
 * have been already contracted with their counterparts in "vector", etc. 
 * and therefore "m1","m2" would be obsolete and ready to be removed.
 * However, in terms like "Eps[{m},{n},{l},{idx1}] G[l,I.{idx1},G5]" 
 * "idx1" can not be removed. Therefore the index number unfortunately
 * will increase slowly with continued invocations of "ToDiracBasis".
 *)
  
 
(*----------- UTILITIES FOR HANDLING OF HAT- AND TILDE-PARTS  ------------*)
 
ToHatTildeRules = Dispatch[
 {
   tr[lidx_, {a___, p_Symbol, b___}] :> tr[lidx, {a, Hold[T@p], b}] + 
     tr[lidx, {a, H@p, b}] /; p =!= G5
   ,
   tr[lidx_, {a___, {m_}, b___}] :>
     tr[lidx, {a, Hold[T@{m}], b}] + tr[lidx, {a, H@{m}, b}]
   ,
   (* Test for Head to avoid an infinite loop *)
   S[p_,q_] :> S[ Hold[T@p],Hold[T@q] ] + H[p,q] /;
                  (Head[p] =!= Hold && Head[q] =!= Hold)
 }
];
 
ToHatTilde[expr_] := expr //. ToHatTildeRules // Expand;
 
RemoveHatMomenta[expr_, p__] := 
   Block[ {plist={p}, q, rule={}, i},
          Do [
               q = plist[[i]];
               AppendTo[rule, H[q]   -> 0];
               AppendTo[rule, H[q,_] -> 0];
               , {i,Length[plist]}
             ];
          rule = Dispatch[rule];
          expr //.  rule
        ];
 
 
(*-------------- ADDITIONAL RULES FOR NONCOMMUTATIVEMULTIPLY -------------*)
 
(*
 * These rules have to be placed at the end of Tracer, because otherwise
 * they would match left-hand sides of previous rules and hence alter them.
 *)
 
Unprotect[NonCommutativeMultiply];
 
a___ ** 0 ** e___ = 0;
 
a___ ** Times[b_,c__] ** e___ := b a ** Times[c] ** e /; Not[Head[b]===tr];
 
a___ ** Plus[ b_,c__] ** e___ := a ** b ** e + a ** Plus[c] ** e;
 
a___ ** (s_ tr[l_, {b___}]) ** c___ :=
   s a ** tr[l, {b}] ** c /; Not[ Head[s] === tr ];
 
NonCommutativeMultiply[a__] := Times[a] /; NCMflag &&
   If[ FreeQ[{a}, tr], False,
       Block[ { i, list={}, pos},
       pos = Position[ {a}, tr[___] ];
       Do[ list = Append[ list, {a}[[ pos[[i]] /. List[ex___]->ex, 1 ]] ]
          ,{i, Length[pos]}
         ];
       Union[list] === Sort[list] ]
     ];
 
Protect[NonCommutativeMultiply];
 
tr /: tr[l_,{a___}] ** b__ := b tr[l,{a}] /; FreeQ[{b}, tr];
 
tr /: b__ ** tr[l_,{a___}] := b tr[l,{a}] /; FreeQ[{b}, tr];
 
tr /: tr[l_,{a___}] ** tr[l_,{b___}] := tr[l,{a,b}];
 
tr /: a___ ** tr[l_,{b___}] ** f__ ** tr[l_,{c___}] ** e___ :=
      a ** tr[l,{b,c}] ** f ** e /; FreeQ[{f}, tr[l,{___}] ];
 
 
(*------------- PROTECT SPECICAL SYMBOLS FROM ACCIDENTAL USE -------------*)
 
Protect[ AntiCommute, ContractEpsGamma, Eps, G, GammaTrace, G5, H,
         ListCommands, NoSpur, OnShell, OutputFormat, RemoveHatMomenta,
         RemoveNCM, S, Sigma, SortLine, Spur, T, ToDiracBasis,
         ToHatTilde, ToOtimes, ToUG5, U, VectorDimension, Version ];
 
 
(*---------------------------- CLOSE CONTEXTS ----------------------------*)
 
End[ (* Tracer`Private` *) ];
 
EndPackage[ (* Tracer` *) ];
 
 
(*--------------- DISPLAY DEFAULT SETTINGS ON STARTUP --------------------*)
 
RemoveNCM[ on ];
 
OutputFormat[ texlike ];
 
AntiCommute[ off ];
 
 
(*======================= END OF FILE Tracer-1.1.m =======================*)
