4D N = 1 SG OnShell 4DCalcs.nb

Setting Rep and Importing Adinkra package

$RecursionLimit=Infinity

Rep = SGOnShell;

<<Adinkra`

BuildDate[Adinkra]

fields: hfield[μ,ν], ψ[μ][a], all free indices covariant       
AdinkraReduce and TemporalGauge: (Subscript[h, 0μ])=(Subscript[ψ, 0a])=0
(Subscript[Φ, i]) = {(Subscript[(OverDot[h]), 1i]),(Subscript[(OverDot[h]), 22]),(Subscript[(OverDot[h]), 23]),(Subscript[(OverDot[h]), 33])}
(Subscript[Ψ, (OverHat[i])])= {(Subscript[(OverDot[ψ]), 1a]),(Subscript[(OverDot[ψ]), 2a]),(Subscript[(OverDot[ψ]), 3a])}

AdinkraReduce

AdinkraReduce={ hfield[m_,n_]-> Function[{t,x,y,z},hfield[m,n][t]],ψ[m_][a_]-> Function[{t,x,y,z},ψ[m][a][t]]}

fields

fields={ψ[m_][a_][t]->(Subscript[ψ, 10*m+a]),ψ[m_][a_]'[t]->(Subscript[(OverDot[ψ]), 10*m+a]),
 hfield[m_,n_][t]->(Subscript[h, 10*m+n]), hfield[m_,n_]'[t]->(Subscript[(OverDot[h]), 10*m+n]),hfield[m_,n_]''[t]->(Subscript[h'', 10*m+n])}

ψ[1][2]'[t]/.fields

The temporal gauge,(Subscript[h, 0μ])= (Subscript[ψ, 0a]) = 0 is the gauge we will use for the Adinkras

TemporalGauge = {hfield[0,m_]->Function[{t},0],ψ[0][a_]->Function[{t},0]}

D[hfield[0,1][t],t]

%/.TemporalGauge

D[ψ[0][1][t],t]

%/.TemporalGauge

D[ψ[0][1][t,x,y,z],x]/.AdinkraReduce

D[ψ[0][1][t,x,y,z],t]/.AdinkraReduce

%/.TemporalGauge

D[ψ[1][1][t,x,y,z],t]/.AdinkraReduce

%/.TemporalGauge

Phi[t][[i]] := (Subscript[Φ, i]) = {(Subscript[(OverDot[h]), 1i]),(Subscript[(OverDot[h]), 22]),(Subscript[(OverDot[h]), 23]),(Subscript[(OverDot[h]), 33])}
Psi[t][[ihat]] := (Subscript[Ψ, (OverHat[i])])= {(Subscript[(OverDot[ψ]), 1a]),(Subscript[(OverDot[ψ]), 2a]),(Subscript[(OverDot[ψ]), 3a])}

Phi[t] = {hfield[1,1]'[t],hfield[1,2]'[t],hfield[1,3]'[t],hfield[2,2]'[t],hfield[2,3]'[t],hfield[3,3]'[t]}

Psi[t] = -I {ψ[1][1]'[t],ψ[1][2]'[t],ψ[1][3]'[t],ψ[1][4]'[t],ψ[2][1]'[t],ψ[2][2]'[t],ψ[2][3]'[t],ψ[2][4]'[t],ψ[3][1]'[t],ψ[3][2]'[t],ψ[3][3]'[t],ψ[3][4]'[t]}

Phi[t]/.fields

I Psi[t]/.fields

FieldList:= list of the names of the fields, FieldListWithDerivaties := list of all Fields and their derivatives up to second order

FieldList = {Table[hfield[mu,nu][t,x,y,z],{mu,0,3},{nu,mu,3}],ψ[0][1][t,x,y,z],ψ[0][2][t,x,y,z],ψ[0][3][t,x,y,z],ψ[0][4][t,x,y,z],ψ[1][1][t,x,y,z],ψ[1][2][t,x,y,z],ψ[1][3][t,x,y,z],ψ[1][4][t,x,y,z],ψ[2][1][t,x,y,z],ψ[2][2][t,x,y,z],ψ[2][3][t,x,y,z],ψ[2][4][t,x,y,z],ψ[3][1][t,x,y,z],ψ[3][2][t,x,y,z],ψ[3][3][t,x,y,z],ψ[3][4][t,x,y,z]}//Flatten

FieldListWithDerivatives = Join[FieldList,Table[D[FieldList,Ϛ[mu]],{mu,0,3}]//Flatten,Table[D[FieldList,Ϛ[mu],Ϛ[nu]],{mu,0,3},{nu,0,3}]//Flatten];

Symmetries, Constraints, and raised indices

Hard code the indices of (Subscript[h, μν]) so the independent fields are: (Subscript[h, 0μ]), (Subscript[h, 1i]), (Subscript[h, 22]), (Subscript[h, 23]) , (Subscript[h, 33])

hfield[1,0][t,x,y,z]=hfield[0,1][t,x,y,z];
hfield[2,0][t,x,y,z]=hfield[0,2][t,x,y,z];
hfield[3,0][t,x,y,z]=hfield[0,3][t,x,y,z];
hfield[2,1][t,x,y,z]=hfield[1,2][t,x,y,z];
hfield[3,1][t,x,y,z]=hfield[1,3][t,x,y,z];
hfield[3,2][t,x,y,z] =hfield[2,3][t,x,y,z];

Do[hfield[mu,nu][t] = hfield[mu,nu][t,x,y,z]/.AdinkraReduce,{mu,0,3},{nu,0,3}]

hfield[0,1][t]

hfield[3,3][t,x,y,z]

D[hfield[3,3][t,x,y,z],z]

hfield[1,0][t,x,y,z]

D[hfield[1,0][t,x,y,z],t]/.AdinkraReduce

hfieldupdown[mu,nu] := (Subscript[(h^μ), ν])  ,  hfielddownup[mu,nu] := ((Subscript[h, μ])^ν)  ,  hfieldupup[mu,nu] := (h^(μν))   htrace = (η^(μν))(Subscript[h, μν])

Table[hfield[mu,nu][t,x,y,z],{mu,0,3},{nu,0,3}]

Do[hfieldupdown[mu,nu][t,x,y,z] = RaiseSTIndex[hfield[mu,nu][t,x,y,z],UP,DOWN],{mu,0,3},{nu,0,3}]

Table[hfieldupdown[mu,nu][t,x,y,z],{mu,0,3},{nu,0,3}]//MatrixForm

Do[hfielddownup[mu,nu][t,x,y,z] = RaiseSTIndex[hfield[mu,nu][t,x,y,z],DOWN,UP],{mu,0,3},{nu,0,3}]

Table[hfielddownup[mu,nu][t,x,y,z],{mu,0,3},{nu,0,3}]//MatrixForm

Do[hfieldupup[mu,nu][t,x,y,z] = RaiseSTIndex[hfield[mu,nu][t,x,y,z],UP,UP],{mu,0,3},{nu,0,3}]

Table[hfieldupup[mu,nu][t,x,y,z],{mu,0,3},{nu,0,3}]//MatrixForm

htrace[t,x,y,z] = Sum[η[mu,nu]hfield[mu,nu][t,x,y,z],{mu,0,3},{nu,0,3}]

ψstup[μ][a] := (Subscript[(ψ^μ), a])    ψstupup[μ][a]:=(ψ^(μa))    ψstdownup[μ][a]:=((Subscript[ψ, μ])^a)

Do[ψstup[mu][aa][t,x,y,z] = RaiseSTIndex[ψ[mu][aa][t,x,y,z]],{mu,0,3},{aa,1,4}]

Table[ψstup[mu][aa][t,x,y,z],{mu,0,3},{aa,1,4}]//MatrixForm

Do[ψstupup[mu][aa][t,x,y,z]= RaiseFermionIndex[ψstupHolder[mu][aa][t,x,y,z]]/.ψstupHolder->ψstup,{mu,0,3},{aa,1,4}]

Table[ψstupup[mu][aa][t,x,y,z],{mu,0,3},{aa,1,4}]//MatrixForm

InverseCmetric//MatrixForm

Do[ψstdownup[mu][aa][t,x,y,z]= RaiseFermionIndex[ψ[mu][aa][t,x,y,z]],{mu,0,3},{aa,1,4}]

Table[ψstdownup[mu][aa][t,x,y,z],{mu,0,3},{aa,1,4}]//MatrixForm

Rfield[a] := (Subscript[R, a]) =   ([(γ^μ),(γ^ν)](()_a)^b)(∂_μ)(Subscript[ψ, ν b])

Do[Rfield[aa][t,x,y,z] = Sum[CommuteGamma[mu,nu][[aa,bi]]D[ψ[nu][bi][t,x,y,z],Ϛ[mu]],{mu,0,3},{nu,0,3},{bi,1,4}],{aa,1,4}]

D[Rfield[1][t,x,y,z],x]

%/.AdinkraReduce

D[Rfield[1][t,x,y,z],t]

%/.AdinkraReduce

Rfieldup[a] := (C^ab)(Subscript[R, b])

Do[Rfieldup[aa][t,x,y,z] = RaiseFermionIndex[RfieldHolder[aa][t,x,y,z]]/.RfieldHolder->Rfield,{aa,1,4}]

Rfieldup[1][t,x,y,z]

Rfield[2][t,x,y,z]

Rfield[1][t,x,y,z]==Rfieldup[2][t,x,y,z]

Gravitino Equation of motion:Eψ[κ][c]:= (Subscript[E, κc])= ((Subscript[ϵ, κ])^(ναβ))((Subscript[((γ^5)(Subscript[γ, ν])), c])^d)(∂_α)(Subscript[ψ, β d])

Do[Eψ[kp][cc][t,x,y,z] = Sum[ϵdownupupup[kp,nu,ap,bt]γ5γstdown[nu][[cc,dd]]D[ψ[bt][dd][t,x,y,z],Ϛ[ap]],{nu,0,3},{ap,0,3},{bt,0,3},{dd,1,4}],{kp,0,3},{cc,1,4}]

Do[Eψstup[mu][ai][t,x,y,z] = RaiseSTIndex[EψHolder[mu][ai][t,x,y,z]]/.EψHolder-> Eψ,{mu,0,3},{ai,1,4}]

Eψstup[0][1][t,x,y,z]

Eψ[0][1][t,x,y,z]==-Eψstup[0][1][t,x,y,z]

Do[Eψstupup[mu][ai][t,x,y,z]= RaiseFermionIndex[EψstupHolder[mu][ai][t,x,y,z]]/.EψstupHolder->Eψstup,{mu,0,3},{ai,1,4}]

Eψ[0][1][t,x,y,z]

Eψstupup[0][1][t,x,y,z]

Do[Eψup[mu][ai][t,x,y,z]= RaiseFermionIndex[EψHolder[mu][ai][t,x,y,z]]/.EψHolder->Eψ,{mu,0,3},{ai,1,4}]

Eψ[0][1][t,x,y,z]

Eψup[0][1][t,x,y,z]

Table[Sum[I γ[kp][[aa,bb]]Eψ[kp][bb][t,x,y,z],{kp,0,3},{bb,1,4}],{aa,1,4}]==Table[Rfield[aa][t,x,y,z],{aa,1,4}]//Simplify

Check UD[Field_,Ϛ[μ]] := (∂^μ)Field   ,   Lap[Field_] := (∂^μ)(∂_μ)Field defined in SpaceTime2.nb. Doesn’t matter in which order these are taken when strung together.

D[UD[hfield[0,1][t,x,y,z],Ϛ[0]],Ϛ[0]]

UD[D[hfield[0,1][t,x,y,z],Ϛ[0]],Ϛ[0]]

Lap[D[hfield[0,1][t,x,y,z],Ϛ[0]]]

D[Lap[hfield[0,1][t,x,y,z]],Ϛ[0]]

UD[D[Lap[hfield[0,1][t,x,y,z]],Ϛ[0]],Ϛ[0]]

Lap[Lap[hfield[1,0][t,x,y,z]]]

Lap[Lap[hfieldupup[1,0][t,x,y,z]]]

Lap[ψ[0][1][t,x,y,z]]

UD[ψ[0][1][t,x,y,z],Ϛ[1]]

UD[ψ[0][1][t,x,y,z],Ϛ[0]]

UD[Rfieldup[1][t,x,y,z],Ϛ[0]]

Transformation Laws

Do[Da[aa][hfield[mu,nu][t,x,y,z]]= (1/2) Sum[( γstdown[mu][[aa,bb]]) ψ[nu][bb][t,x,y,z] +( γstdown[nu][[aa,bb]]) ψ[mu][bb][t,x,y,z],{bb,1,4}],{aa,1,4},{mu,0,3},{nu,0,3}]

Do[Da[cc][htrace[t,x,y,z]] =Sum[η[mu,nu]Da[cc][hfield[mu,nu][t,x,y,z]] ,{mu,0,3},{nu,0,3}],{cc,1,4}]

Da[1][htrace[t,x,y,z]]

Do[DColor[hfield[mu,nu]'[t]] = Table[D[Da[Color][hfield[mu,nu][t,x,y,z]]/.AdinkraReduce/.TemporalGauge,t],{Color,1,4}],{mu,0,3},{nu,0,3}]

PrintDColor[hfield'[t]]=Table[Collect[DColor[hfield[mu,nu]'[t]][[Color]],{ ψ[ap_][c_][t], ψ[ap_][c_]'[t]},Simplify],{mu,0,3},{nu,0,3},{Color,1,4}]/.fields//MatrixForm

check symmetry

Table[Da[aa][hfield[mu,nu][t,x,y,z]]-Da[aa][hfield[nu,mu][t,x,y,z]],{aa,1,4},{mu,0,3},{nu,0,3}]//Simplify

Table[DColor[hfield[mu,nu]'[t]] - DColor[hfield[nu,mu]'[t]],{mu,0,3},{nu,0,3}]//Simplify

Do[Da[aa][ψ[mu][bb][t,x,y,z]] =  - I  (1/(2 ))Sum[CommuteGammadown[ap,bt][[aa,bb]]D[hfield[bt,mu][t,x,y,z],Ϛ[ap]],{ap,0,3},{bt,0,3}] ,{aa,1,4},{bb,1,4},{mu,0,3}]

Do[DColor[-I ψ[mu][bi]'[t]] = Table[D[-I Da[Color][ψ[mu][bi][t,x,y,z]]/.AdinkraReduce/.TemporalGauge,t],{Color,1,4}],{mu,0,3},{bi,1,4}]

PrintDColor[-I ψ'[t]]=Table[Collect[DColor[-I ψ[mu][aa]'[t]][[Color]],{ hfield[ap_,bt_][t],hfield[ap_,bt_]'[t]},Simplify],{mu,0,3},{aa,1,4},{Color,1,4}]/.fields//MatrixForm

DD

SUSYTransformFields[Operator_]:=Table[FieldList[[FieldIndex]]->Operator[FieldList[[FieldIndex]]],{FieldIndex,1,Length[FieldList]}]

SUSYTransformJusth[Operator_]:=Table[FieldList[[FieldIndex]]->Operator[FieldList[[FieldIndex]]],{FieldIndex,1,10}]

Do[SUSYTransform[Da[ai]] = Join[SUSYTransformFields[Da[ai]],D[SUSYTransformFields[Da[ai]],t],D[SUSYTransformFields[Da[ai]],x],D[SUSYTransformFields[Da[ai]],y],D[SUSYTransformFields[Da[ai]],z],D[SUSYTransformJusth[Da[ai]],t,t],D[SUSYTransformJusth[Da[ai]],t,x],D[SUSYTransformJusth[Da[ai]],t,y],D[SUSYTransformJusth[Da[ai]],t,z],D[SUSYTransformJusth[Da[ai]],x,x],D[SUSYTransformJusth[Da[ai]],x,y],D[SUSYTransformJusth[Da[ai]],x,z],D[SUSYTransformJusth[Da[ai]],z,z],D[SUSYTransformJusth[Da[ai]],y,y],D[SUSYTransformJusth[Da[ai]],y,z]],{ai,1,4}]

DD[LeftOperator_,RightOperator_][Field_]:=RightOperator[Field]/.SUSYTransform[LeftOperator]

AlgebraDD[LeftOperator_,RightOperator_][Field_]:= DD[LeftOperator,RightOperator][Field] + DD[RightOperator,LeftOperator][Field]

AlgebraDDTable[Field_] := Table[AlgebraDD[Da[ai],Da[bi]][Field],{ai,1,4},{bi,1,4}]

HoloraumyDD[LeftOperator_,RightOperator_][Field_]:= DD[LeftOperator,RightOperator][Field] - DD[RightOperator,LeftOperator][Field]

HoloraumyDDTable[Field_]:=Table[HoloraumyDD[Da[ai],Da[bi]][Field],{ai,1,4},{bi,1,4}]

Closure[ai_,bi_][Field_]:=Sum[2 I γdown[m][[ai,bi]]D[Field,Ϛ[m]],{m,0,3}]

ClosureTable[Field_]:=Table[Closure[ai,bi][Field],{ai,1,4},{bi,1,4}]

Table[Closure[ii,ji][ψ[0][ki][t,x,y,z]],{ii,1,4},{ji,1,4},{ki,1,4}]

Algebra

{(Subscript[D, a]),(Subscript[D, b])}(Subscript[h, μν])= 2 i (Subscript[( (γ^α)  ), ab])  (∂_α) (Subscript[h, μν]) - (∂_((μ))(Subscript[ζ, ν)ab])  
with (Subscript[ζ, νab])= i (Subscript[(γ^α)  , ab])  (Subscript[h, να])

Do[ζGauge[Rep][nu] = I Sum[γdown[ap]hfield[nu,ap][t,x,y,z],{ap,0,3}],{nu,0,3}]

ClosureResult[1] = (Table[AlgebraDDTable[hfield[mu,nu][t,x,y,z]],{mu,0,3},{nu,0,3}] ==Table[ClosureTable[hfield[mu,nu][t,x,y,z]]  - (D[ζGauge[Rep][nu],Ϛ[mu]]+D[ζGauge[Rep][mu],Ϛ[nu]]),{mu,0,3},{nu,0,3}])//Simplify

ϵGaugeTerms[aa_,bb_,cc_]:=I (1/8)Sum[(10 γdown[ap][[aa,bb]] KroneckerDelta[cc,dd] + Sum[- CommuteGammadown[ap,bt][[aa,bb]]γstdown[bt][[cc,dd]] + γstdowndown[bt][[aa,bb]]CommuteGamma[bt,ap][[cc,dd]] - (γ5.CommuteGammadown[ap,bt])[[aa,bb]]γ5γstdown[bt][[cc,dd]],{bt,0,3}])ψ[ap][dd][t,x,y,z],{ap,0,3},{dd,1,4}]

ϵGauge[Rep] = Table[ϵGaugeTerms[aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}];

Z11Terms[mu_,ro_][cc_]:=Sum[(1/4) CommuteGammastdown[mu,ro][[cc,dd]]Rfield[dd][t,x,y,z] -I(1/2)γstdown[mu][[cc,dd]]Eψ[ro][dd][t,x,y,z] + I(3/4) γstdown[ro][[cc,dd]]Eψ[mu][dd][t,x,y,z],{dd,1,4}]

Z12Terms[mu_,ro_,sg_][cc_]:= I(1/4)η[mu,ro]Eψ[sg][cc][t,x,y,z] +I (1/32) Sum[CommuteGammastdown[ro,sg][[cc,dd]]Eψ[mu][dd][t,x,y,z],{dd,1,4}] +(1/8) Sum[ϵdowndowndownup[mu,ro,sg,kp]γ5[[cc,dd]]Eψ[kp][dd][t,x,y,z],{kp,0,3},{dd,1,4}]

Z1Terms[mu_][aa_,bb_,cc_]:= Sum[I γdown[ro][[aa,bb]]Z11Terms[mu,ro][cc],{ro,0,3}] + Sum[I CommuteGammadown[ro,sg][[aa,bb]]Z12Terms[mu,ro,sg][cc],{ro,0,3},{sg,0,3}]

Do[Z1[Rep][mu] = Table[Z1Terms[mu][aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}],{mu,0,3}]

ClosureResult[2]= Collect[Table[AlgebraDD[Da[aa],Da[bb]][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] ==(Table[Closure[aa,bb][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] -Table[D[ϵGauge[Rep],Ϛ[mu]],{mu,0,3}] - Table[Z1[Rep][mu],{mu,0,3}]),Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Check against SSTPRS result found in adnkOnHolor.v5

AlgebraSSTPRS[mu_][aa_,bb_,cc_]:=I Sum[γdown[kp][[aa,bb]]D[ψ[mu][cc][t,x,y,z],Ϛ[kp]],{kp,0,3}] - I (1/4)Sum[γdown[kp][[aa,bb]]D[ψ[kp][cc][t,x,y,z],Ϛ[mu]],{kp,0,3}] - (1/4)Sum[ϵdowndownupup[mu,kp,ap,bt]γdown[kp][[aa,bb]]γ5[[cc,dd]]D[ψ[bt][dd][t,x,y,z],Ϛ[ap]],{kp,0,3},{ap,0,3},{bt,0,3},{dd,1,4}]-I (1/8)Sum[(γstdowndown[kp][[aa,bb]]CommuteGamma[kp,ld][[cc,dd]]+ CommuteGammadown[kp,ld][[aa,bb]]γstdown[kp][[cc,dd]] + (γ5.CommuteGammadown[kp,ld])[[aa,bb]]γ5γstdown[kp][[cc,dd]])(2 D[ψ[mu][dd][t,x,y,z],Ϛ[ld]] - D[ψ[ld][dd][t,x,y,z],Ϛ[mu]]),{kp,0,3},{ld,0,3},{dd,1,4}] - I (1/8)Sum[(γdown[kp][[aa,bb]]CommuteGammastdownstup[mu,ld][[cc,dd]] + CommuteGammastdownstupdown[mu,ld][[aa,bb]]γ[kp][[cc,dd]]+(γ5.CommuteGammastdownstupdown[mu,ld])[[aa,bb]]γ5γ[kp][[cc,dd]])(D[ψ[ld][dd][t,x,y,z],Ϛ[kp]]-D[ψ[kp][dd][t,x,y,z],Ϛ[ld]]),{kp,0,3},{ld,0,3},{dd,1,4}] - I (1/8)Sum[(γstdowndown[mu][[aa,bb]]CommuteGamma[kp,ld][[cc,dd]] + CommuteGammadown[kp,ld][[aa,bb]]γstdown[mu][[cc,dd]] + (γ5.CommuteGammadown[kp,ld])[[aa,bb]]γ5γstdown[mu][[cc,dd]])D[ψ[ld][dd][t,x,y,z],Ϛ[kp]],{kp,0,3},{ld,0,3},{dd,1,4}]

Collect[Table[AlgebraDD[Da[aa],Da[bb]][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] ==Table[AlgebraSSTPRS[mu][aa,bb,cc],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] ,Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

ClosureResult[2]= Collect[Table[AlgebraSSTPRS[mu][aa,bb,cc],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] ==(Table[Closure[aa,bb][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}] -Table[D[ϵGauge[Rep],Ϛ[mu]],{mu,0,3}] - Table[Z1[Rep][mu],{mu,0,3}]),Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Algebra Summary

ClosureResult[1]==ClosureResult[2]==True

Holoraumy, confirmed by hand that these match the SSTPRS derived results as in adnkOnHolor.v5 on 4/22/19

with

BHoloTerms[mu_,nu_,ro_,ap_,bt_][aa_,bb_]:= -I (1/2) Sum[η[bt,mu]ϵ[nu,ro,ap,kp]γ5γdown[kp][[aa,bb]]+η[bt,nu]ϵ[mu,ro,ap,kp]γ5γdown[kp][[aa,bb]],{kp,0,3}]

Do[BHolo[Rep][mu,nu,ro,ap,bt]= Table[BHoloTerms[mu,nu,ro,ap,bt][aa,bb],{aa,1,4},{bb,1,4}],{mu,0,3},{nu,0,3},{ro,0,3},{ap,0,3},{bt,0,3}]

HoloraumyResult[1] =Table[HoloraumyDDTable[hfield[mu,nu][t,x,y,z]],{mu,0,3},{nu,0,3}] ==  Table[-2 I Sum[BHolo[Rep][mu,nu,ro,ap,bt]UD[hfieldupup[ap,bt][t,x,y,z],Ϛ[ro]],{ro,0,3},{ap,0,3},{bt,0,3}],{mu,0,3},{nu,0,3}]//Simplify

whereand

and

FHoloTerms[mu_,ap_,bt_][aa_,bb_,cc_,dd_]:=- (3/4) (η[mu,ap]γ5γstdowndown[bt][[aa,bb]]γ5[[cc,dd]]-η[mu,bt]γ5γstdowndown[ap][[aa,bb]]γ5[[cc,dd]])+ I (1/8)Sum[ϵ[mu,ap,bt,nu]γ5γdown[nu][[aa,bb]]KroneckerDelta[cc,dd],{nu,0,3}] + (1/16)(γ5γstdowndown[ap][[aa,bb]](γ5.CommuteGammastdown[bt,mu])[[cc,dd]]-γ5γstdowndown[bt][[aa,bb]](γ5.CommuteGammastdown[ap,mu])[[cc,dd]])

Do[FHolo[Rep][mu,ap,bt] = Table[ FHoloTerms[mu,ap,bt][aa,bb,cc,dd],{aa,1,4},{bb,1,4},{cc,1,4},{dd,1,4}],{mu,0,3},{ap,0,3},{bt,0,3}]

ZHoloTerms[mu_][aa_,bb_,cc_]:=I (1/2)Sum[(-Cmetric[[aa,bb]]γstdown[mu][[cc,dd]]-γ5down[[aa,bb]]γ5γstdown[mu][[cc,dd]]+ (1/2)Sum[γ5γdown[sg][[aa,bb]]γ5γγstdownstdown[sg,mu][[cc,dd]],{sg,0,3}] - (1/4)γ5γstdowndown[mu][[aa,bb]]γ5[[cc,dd]])Rfield[dd][t,x,y,z],{dd,1,4}]- (1/4)Sum[(5Cmetric[[aa,bb]]KroneckerDelta[cc,dd]+5γ5down[[aa,bb]]γ5[[cc,dd]]-2Sum[γ5γdown[sg][[aa,bb]]γ5γstdown[sg][[cc,dd]],{sg,0,3}])Eψ[mu][dd][t,x,y,z],{dd,1,4}]

Do[ZHolo[Rep][mu]=Table[ZHoloTerms[mu][aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}],{mu,0,3}]

ZetaGaugeHoloTerms[aa_,bb_,cc_]:=I (3/4)Sum[(Cmetric[[aa,bb]]γ[bt][[cc,dd]]+ γ5down[[aa,bb]]γ5γ[bt][[cc,dd]]+γ5γdown[bt][[aa,bb]]γ5[[cc,dd]]-(1/6)Sum[γ5γstdowndown[kp][[aa,bb]](γ5.CommuteGamma[kp,bt])[[cc,dd]],{kp,0,3}])ψ[bt][dd][t,x,y,z],{bt,0,3},{dd,1,4}]

ZetaGaugeHolo[Rep]=Table[ZetaGaugeHoloTerms[aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}];

HoloraumyResult[2]=Collect[Table[HoloraumyDD[Da[aa],Da[bb]][ψ[mu][cc][t,x,y,z]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]==(-2I Table[Sum[FHolo[Rep][mu,ap,bt][[aa,bb,cc,dd]]UD[ψstup[bt][dd][t,x,y,z],Ϛ[ap]],{ap,0,3},{bt,0,3},{dd,1,4}],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]-Table[ZHolo[Rep][mu][[aa,bb,cc]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]-Table[D[ZetaGaugeHolo[Rep][[aa,bb,cc]],Ϛ[mu]],{mu,0,3},{aa,1,4},{bb,1,4},{cc,1,4}]),Derivative[_,_,_,_][ψ[_][_]][t,x,y,z],Simplify]

Holoraumy Summary

HoloraumyResult[1]==HoloraumyResult[2]==True

ℒ = ((-1)/(2 )) (∂_α)(Subscript[h, μν]) (∂^α)(h^(μν)) + (1/2)  (∂^α)h (∂_α)h -(∂^α)h (∂^β)(Subscript[h, αβ]) +(∂^μ)(Subscript[h, μν])(∂_α)(h^(αν))
- (1/2) (Subscript[ψ, μb]) (((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^bc)(∂_α)(Subscript[ψ, βc])
(Subscript[D, c])ℒ = 0 =((Subscript[D, c])(Subscript[h, μν]))□(h^(μν)) -((Subscript[D, c])h)□h+((Subscript[D, c])h)(∂_μ)(∂_ν)(h^(μν))+((Subscript[D, c])(Subscript[h, μν]))(∂^μ)(∂^ν)h-2((Subscript[D, c])(Subscript[h, αν])) (∂^α)(∂_μ)(h^(μν)) + (Subscript[ψ, μa])(((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^ab)(∂_α)(Subscript[D, c])(Subscript[ψ, βb])

Lh = (((Subscript[D, c])(Subscript[h, μν]))□(h^(μν)) -((Subscript[D, c])h)□h+((Subscript[D, c])h)(∂_μ)(∂_ν)(h^(μν))+((Subscript[D, c])(Subscript[h, μν]))(∂^μ)(∂^ν)h-2((Subscript[D, c])(Subscript[h, αν])) (∂^α)(∂_μ)(h^(μν)))

Lh = Table[Sum[Da[cc][hfield[mu,nu][t,x,y,z]]Lap[hfieldupup[mu,nu][t,x,y,z]] ,{mu,0,3},{nu,0,3}] -  Da[cc][htrace[t,x,y,z]]Lap[htrace[t,x,y,z]] +  Da[cc][htrace[t,x,y,z]]Sum[D[hfieldupup[mu,nu][t,x,y,z],Ϛ[mu],Ϛ[nu]],{mu,0,3},{nu,0,3}] +  Sum[Da[cc][hfield[mu,nu][t,x,y,z]]UD[UD[htrace[t,x,y,z],Ϛ[mu]],Ϛ[nu]],{mu,0,3},{nu,0,3}]- 2Sum[Da[cc][hfield[ap,nu][t,x,y,z]]D[UD[hfieldupup[mu, nu][t,x,y,z],Ϛ[ap]],Ϛ[mu]],{mu,0,3},{nu,0,3},{ap,0,3}],{cc,1,4}];

Lh = Collect[Lh,{ψ[_][_][t,x,y,z],λ[_][t,x,y,z]},Simplify]

LPsi=(Subscript[D, c])( -(1/2) (Subscript[ψ, μa]) (((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^ab)(∂_α)(Subscript[ψ, βb]))=  (Subscript[ψ, μa])(((ϵ^(μναβ ))((γ^5)(Subscript[γ, ν])))^ab)(∂_α)(Subscript[D, c])(Subscript[ψ, βb])

LPsi = Collect[Table[ Sum[ψ[mu][aa][t,x,y,z]ϵup[mu,nu,alpha,beta] γ5γstdownup[nu][[aa,bb]]D[Da[cc][ψ[beta][bb][t,x,y,z]],Ϛ[alpha]],{mu,0,3},{nu,0,3},{alpha,0,3},{beta,0,3},{aa,1,4},{bb,1,4}],{cc,1,4}],{ψ[_][_][t,x,y,z],λ[_][t,x,y,z]},Simplify]

Lagrangian invariance:

DLTotal=( Lh + LPsi  )

DLFinal = Collect[DLTotal,{ψ[_][_][t,x,y,z],λ[_][t,x,y,z],β[_][t,x,y,z],Derivative[_,_,_,_][hfield[_,_]][t,x,y,z],Derivative[_,_,_,_][Afield[_]][t,x,y,z],Afield[_][t,x,y,z],Vfield[_][t,x,y,z],Derivative[_,_,_,_][Sfield][t,x,y,z],Sfield[t,x,y,z],Derivative[_,_,_,_][Pfield][t,x,y,z],Pfield[t,x,y,z],Derivative[_,_,_,_][Vfield[_]][t,x,y,z],Wfield[_][t,x,y,z],Derivative[_,_,_,_][Wfield[_]][t,x,y,z]},Simplify]

Lagrangian Summary

DLFinal == {0,0,0,0}