•Preliminaries

Cosmetics:

VariableBoxes["k"] ; VariableBoxes["τ"] ; VariableBoxes["ρ"] ;

Keep things compact:

(* DeclareUScalar[UTrace1] *)

SetOptions[#, Explicit -> False] & /@ {MM, SMM, UChi, FieldStrengthTensorFull, FieldStrengthTensor, CovariantFieldDerivative, LeftComponent, RightComponent} ;

DeclareUScalar[n] ;

SetOptions[SUNReduce, FullReduce -> True, SUNN -> n] ; SetOptions[UReduce, FullReduce -> True, UDimension -> n, SUNN -> n] ;

SetOptions[IndicesCleanup, LorentzDummys -> {"μ", "μ", "μ", "μ", "μ"}] ;

IsoVector[QuantumField[Particle[LeftComponent[0] | RightComponent[0]], LorentzIndex[_]]][_] := 0 ;

QuantumField[Particle[lr : (LeftComponent[0] | RightComponent[0])], r___, SUNIndex[0]][x_] := QuantumField[Particle[lr], r][x] ;

UTrace1[FieldStrengthTensorFull[LorentzIndex[μ1_], QuantumField[Particle[LeftComponent[0] | RightComponent[0]], LorentzIndex[μ2_]][x_], x_, ___]] := 0 ;

$UMatrices = Union[$UMatrices, {LeftComponent[0], RightComponent[0]}]

CQLeft | CQRight | GLeft | GRight | H _ L | H _ R | ÷„ | öÆ | χ | χ _ - | χ _ + | UFMinus | UFPlus | UGamma | Q | USmall | L | R

gLRSort = ((# /. {GLeft[LorentzIndex[μ2], LorentzIndex[μ1]][x] -> -GLeft[LorentzIndex[μ1], LorentzIndex[μ2]][x], GRight[LorentzIndex[μ2], LorentzIndex[μ1]][x] -> -GRight[LorentzIndex[μ1], LorentzIndex[μ2]][x]} /. NM[Adjoint[CovariantFieldDerivative[MM[x], x, LorentzIndex[μ2]]], GRight[LorentzIndex[μ1], LorentzIndex[μ2]][x], CovariantFieldDerivative[MM[x], x, LorentzIndex[μ1]]] -> -NM[Adjoint[CovariantFieldDerivative[MM[x], x, LorentzIndex[μ1]]], GRight[LorentzIndex[μ1], LorentzIndex[μ2]][x], CovariantFieldDerivative[MM[x], x, LorentzIndex[μ2]]]) &) ;

We use k1 and k2 for the indices with 12 values - 8 SU(2) and 4 Lorentz values.

kroneckerRules = {QuantumField[Particle[UPerturbation], LorentzIndex[μ__]][x_] QuantumField[pd___, Particle[UPerturbation], SUNIndex[k_]][x_] a_ :> QuantumField[Particle[UPerturbation], SUNIndex[k1]][x] QuantumField[pd, Particle[UPerturbation], SUNIndex[k2]][x] (a /. k -> k2) KroneckerDelta[LorentzIndex[μ], SUNIndex[k1]], QuantumField[p___, Particle[UPerturbation], LorentzIndex[μ__]][x_] QuantumField[Particle[UPerturbation], SUNIndex[k_]][x_] a_ :> QuantumField[p, Particle[UPerturbation], SUNIndex[k2]][x] QuantumField[Particle[UPerturbation], SUNIndex[k1]][x] (a /. k -> k1) KroneckerDelta[LorentzIndex[μ], SUNIndex[k2]]}

{a_ ξ^( ) _ μ__ QuantumField(pd___, ξ^( ), k : _) (x_) :> ξ^( )^k _ 1 QuantumField(pd, UPerturbation^( ), k _ 2) (x) (a /. k -> k _ 2) δ _ (μ, k _ 1), a_ ξ^( )^k : _ QuantumField(p___, ξ^( ), μ__) (x_) :> QuantumField(p, UPerturbation^( ), k _ 2) (x) ξ^( )^k _ 1 (a /. k -> k _ 1) δ _ (μ, k _ 2)}

kroneckerRules1 = {QuantumField[Particle[UPerturbation], LorentzIndex[μ__]][x_]^2 :> QuantumField[Particle[UPerturbation], SUNIndex[k1]][x] QuantumField[Particle[UPerturbation], SUNIndex[k2]][x] KroneckerDelta[LorentzIndex[μ], SUNIndex[k1]] KroneckerDelta[LorentzIndex[μ], SUNIndex[k2]], (QuantumField[Particle[UPerturbation], LorentzIndex[μ__]][x_] QuantumField[Particle[UPerturbation], SUNIndex[k_]][x_] a_) :> (QuantumField[Particle[UPerturbation], SUNIndex[k1]][x] QuantumField[Particle[UPerturbation], SUNIndex[k2]][x] (a /. k -> k2) KroneckerDelta[LorentzIndex[μ], SUNIndex[k1]])}

{ξ^( ) _ μ__^2 :> ξ^( )^k _ 1 ξ^( )^k _ 2 δ _ (μ, k _ 1) δ _ (μ, k _ 2), a_ ξ^( ) _ μ__ ξ^( )^k : _ :> ξ^( )^k _ 1 ξ^( )^k _ 2 (a /. k -> k _ 2) δ _ (μ, k _ 1)}

projectionRules = {HoldPattern[KroneckerDelta[LorentzIndex[μ_], SUNIndex[j_]] UMatrix[UGenerator[SUNIndex[j_]]]] -> 0, HoldPattern[KroneckerDelta[LorentzIndex[μ_], SUNIndex[j_]] NM[___, UMatrix[UGenerator[SUNIndex[j_]]], ___]] -> 0, HoldPattern[KroneckerDelta[LorentzIndex[μ_], SUNIndex[j_]] UTrace1[NM[___, UMatrix[UGenerator[SUNIndex[j_]]], ___]]] -> 0, UMatrix[UGenerator[LorentzIndex[_]]] -> 0, KroneckerDelta[LorentzIndex[_], SUNIndex[_]]^2 -> 4, KroneckerDelta[LorentzIndex[mu_], SUNIndex[i_]] KroneckerDelta[LorentzIndex[nu_], SUNIndex[i_]] -> KroneckerDelta[LorentzIndex[mu], LorentzIndex[nu]], KroneckerDelta[LorentzIndex[mu_], LorentzIndex[nu_]]^2 -> 4, CovariantNabla[_, _, SUNIndex[_]] -> 0}

{HoldPattern[δ _ (μ_, j_) σ^j_] -> 0, HoldPattern[δ _ (μ_, j_) (___ '6 σ^j_ '6 ___)] -> 0, HoldPattern[δ _ (μ_, j_) < ___ '6 σ^j_ '6 ___ >] -> 0, UMatrix(σ(_)) -> 0, δ _ (_, _)^2 -> 4, δ _ (mu_, i_) δ _ (nu_, i_) -> δ _ (mu, nu), δ _ (mu_, nu_)^2 -> 4, CovariantNabla(_, _, _) -> 0}

applyProjectionRules[e_] := FixedPoint[(# /. KroneckerDelta[a_, b_] c_ :> (c /. b -> a) /; (FreeQ[c, KroneckerDelta] && ! FreeQ[c, b]) /. projectionRules) &, e] ;

applyProjectionRules[e_] := (e //. KroneckerDelta[a_, b_] c_ :> (c /. b -> a) /; (FreeQ[c, KroneckerDelta] && ! FreeQ[c, b]) //. projectionRules) ;

Converted by Mathematica  (July 10, 2003)