4D N = 1 TS 4DCalcs.nb
This is the same on and offshell

Setting Rep and Importing Adinkra package

$RecursionLimit=Infinity

Rep = TS;

<<Adinkra`

BuildDate[Adinkra]

fields: Bmn[mu],ϕ, χ[a], all free indices covariant
AdinkraReduce
(Subscript[Φ, i]) = {(OverDot[ϕ]), 2(Subscript[(OverDot[B]), 12]),2(Subscript[(OverDot[B]), 23]),2(Subscript[(OverDot[B]), 31])}
(Subscript[Ψ, (OverHat[i])])= {(Subscript[(OverDot[χ]), a])}

AdinkraReduce Encodes reducing the dependence on the fields from 4D space-time to only time

AdinkraReduce={Bmn[mu_,nu_]-> Function[{t,x,y,z},Bmn[mu,nu][t]],ϕ-> Function[{t,x,y,z},ϕ[t]],χ[a_]->Function[{t,x,y,z},χ[a][t]]}

fields := prints out the adinkra reduced fields in subscript form

fields={χ[a_][t]->(Subscript[χ, a]),χ[a_]'[t]->(Subscript[(OverDot[χ]), a]),χ[a_]''[t]->(Subscript[χ, a])'',
 Bmn[mu_,nu_][t]->(Subscript[B, 10*mu+nu]),   Bmn[mu_,nu_]'[t]->(Subscript[(OverDot[B]), 10*mu+nu]),  Bmn[mu]''[t]->(Subscript[B, 10*mu+nu])'',ϕ[t]->ϕ, ϕ'[t]->(OverDot[ϕ])}

χ[2]'[t]/.fields

TeXForm[%]

χ[1][t,x,y,z]/.AdinkraReduce/.fields

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

Phi[t][[i]] = (Subscript[Φ, i]) = {ϕ, 2(Subscript[B, 12]),2(Subscript[B, 23]),2(Subscript[B, 31])}
Psi[t][[ihat]] = (Subscript[Ψ, (OverHat[i])])= {(Subscript[(OverDot[χ]), a])}

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

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

Phi[t]/.fields

I Psi[t]/.fields

FieldList:= list of the names of the fields

FieldList = {ϕ[t,x,y,z],Bmn[0,1][t,x,y,z],Bmn[0,2][t,x,y,z],Bmn[0,3][t,x,y,z],Bmn[1,2][t,x,y,z],Bmn[2,3][t,x,y,z],Bmn[3,1][t,x,y,z],χ[1][t,x,y,z],χ[2][t,x,y,z],χ[3][t,x,y,z],χ[4][t,x,y,z]}

Symmetries, Constraints, and raised indices such as Bmnup, etc.

χup[a] := (χ^a)

Do[χup[ai][t,x,y,z] = RaiseFermionIndex[χ[ai][t,x,y,z]],{ai,1,4}]

InverseCmetric//MatrixForm

Table[χup[ai][t,x,y,z] ,{ai,1,4}]

Symmetrization

Bmn[1,0][t,x,y,z]=-Bmn[0,1][t,x,y,z];
Bmn[2,0][t,x,y,z]=-Bmn[0,2][t,x,y,z];
Bmn[3,0][t,x,y,z]=-Bmn[0,3][t,x,y,z];
Bmn[2,1][t,x,y,z]=-Bmn[1,2][t,x,y,z];
Bmn[3,2][t,x,y,z]=-Bmn[2,3][t,x,y,z];
Bmn[1,3][t,x,y,z]=-Bmn[3,1][t,x,y,z];
Do[Bmn[mu,mu][t,x,y,z]=0,{mu,0,3},{mu,0,3}];

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

Bmnupup, Bmnupdown, Bmndownup

Do[Bmnupup[mu,nu][t,x,y,z] = RaiseSTIndex[BmnHolder[mu,nu][t,x,y,z],UP,UP]/.BmnHolder->Bmn,{mu,0,3},{nu,0,3}]

Do[Bmnupdown[mu,nu][t,x,y,z] = RaiseSTIndex[BmnHolder[mu,nu][t,x,y,z],UP,DOWN]/.BmnHolder->Bmn,{mu,0,3},{nu,0,3}]

Do[Bmndownup[mu,nu][t,x,y,z] = RaiseSTIndex[BmnHolder[mu,nu][t,x,y,z],DOWN,UP]/.BmnHolder->Bmn,{mu,0,3},{nu,0,3}]

The Field strength, covariant and contravariant:  Hamn[α,μ,ν]:=(Subscript[H, αμν]) = (∂_α)(Subscript[B, μν]) +(∂_μ)(Subscript[B, να])+(∂_ν)(Subscript[B, αμ])  ,  Hamnup[α,μ,ν][t,x,y,z] := (H^(αμν)) = (∂^α)(B^(μν)) +(∂^μ)(B^(να)) +(∂^ν)(B^(αμ))

Do[Hamn[α,μ,ν][t,x,y,z] = D[Bmn[μ,ν][t,x,y,z],Ϛ[α]] +D[Bmn[ν,α][t,x,y,z],Ϛ[μ]]+D[Bmn[α,μ][t,x,y,z],Ϛ[ν]],{α,0,3},{μ,0,3},{ν,0,3}]

Do[Hamnup[α,μ,ν][t,x,y,z] =  RaiseSTIndex[HamnHolder[α,μ,ν][t,x,y,z],UP,UP,UP]/.HamnHolder->Hamn,{α,0,3},{μ,0,3},{ν,0,3}]

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

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

Ϛ[3]

D[UD[ϕ[t,x,y,z],Ϛ[0]],Ϛ[0]]

Lap[D[ϕ[t,x,y,z],Ϛ[0]]]

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

Lap[Lap[ϕ[t,x,y,z]]]

Lap[χ[1][t,x,y,z]]

TemporalGauge

TemporalGauge = Bmn[0,mu_]-> Function[{t},0]

Table[Bmn[mu,nu][t,x,y,z],{mu,0,3},{nu,0,3}]/.AdinkraReduce/.TemporalGauge

Transformation Rules

Do[Da[aa][ϕ[t,x,y,z]]= χ[aa][t,x,y,z],{aa,1,4}]

DColor[ϕ'[t]] = Table[D[Da[Color][ϕ[t,x,y,z]]/.AdinkraReduce,t],{Color,1,4}]

PrintDColor[ϕ'[t]]=DColor[ϕ'[t]]/.fields//MatrixForm

Do[Da[a][Bmn[mu,nu][t,x,y,z]]= -(1/4) Sum[CommuteGammastdown[mu,nu][[a,b]]χ[b][t,x,y,z],{b,1,4}],{mu,0,3},{nu,0,3},{a,1,4}]

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

PrintDColor[Bmn'[t]]=Table[DColor[Bmn[mu,nu]'[t]][[Color]],{mu,0,3},{nu,0,3},{Color,1,4}]/.fields//MatrixForm

PrintDColor[Bmn'[t]]

Do[Da[aa][χ[bb][t,x,y,z]] = I Sum[γdown[mu][[aa,bb]]D[ϕ[t,x,y,z],Ϛ[mu]],{mu,0,3}] - Sum[γ5γdown[mu][[aa,bb]]ϵdownupupup[mu,ro,sg,ta]D[Bmn[sg,ta][t,x,y,z],Ϛ[ro]],{mu,0,3},{ro,0,3},{sg,0,3},{ta,0,3}],{aa,1,4},{bb,1,4}]

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

PrintDColor[-I χ'[t]]=Table[Collect[DColor[-I χ[bi]'[t]][[Color]],{Bmn[_]'[t],ϕ[t]} ,Simplify],{bi,1,4},{Color,1,4}]/.fields//MatrixForm

DD

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

SUSYTransformJustB[Operator_]:=Table[FieldList[[FieldIndex]]->Operator[FieldList[[FieldIndex]]],{FieldIndex,1,4}]

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[SUSYTransformJustB[Da[ai]],t,t],D[SUSYTransformJustB[Da[ai]],t,x],D[SUSYTransformJustB[Da[ai]],t,y],D[SUSYTransformJustB[Da[ai]],t,z],D[SUSYTransformJustB[Da[ai]],x,x],D[SUSYTransformJustB[Da[ai]],x,y],D[SUSYTransformJustB[Da[ai]],x,z],D[SUSYTransformJustB[Da[ai]],z,z],D[SUSYTransformJustB[Da[ai]],y,y],D[SUSYTransformJustB[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][χ[ki][t,x,y,z]],{ii,1,4},{ji,1,4},{ki,1,4}]

Algebra

(Table[AlgebraDD[Da[aa],Da[bb]][ϕ[t,x,y,z]],{aa,1,4},{bb,1,4}]== Table[Closure[aa,bb][ϕ[t,x,y,z]],{aa,1,4},{bb,1,4}])//Simplify

Do[qGauge[Rep][mu]=Table[Sum[2I γdown[nu][[aa,bb]](Bmn[mu,nu][t,x,y,z]+ (1/2)η[mu,nu]ϕ[t,x,y,z]),{nu,0,3}],{aa,1,4},{bb,1,4}],{mu,0,3}];

(Table[AlgebraDD[Da[aa],Da[bb]][Bmn[mu,nu][t,x,y,z]],{aa,1,4},{bb,1,4},{mu,0,3},{nu,0,3}]== Table[Closure[aa,bb][Bmn[mu,nu][t,x,y,z]]+D[qGauge[Rep][nu][[aa,bb]],Ϛ[mu]]-D[qGauge[Rep][mu][[aa,bb]],Ϛ[nu]],{aa,1,4},{bb,1,4},{mu,0,3},{nu,0,3}])//Simplify

(Table[AlgebraDD[Da[ai],Da[bi]][χ[ci][t,x,y,z]],{ai,1,4},{bi,1,4},{ci,1,4}] ==Table[Closure[ai,bi][χ[ci][t,x,y,z]] ,{ai,1,4},{bi,1,4},{ci,1,4}] )//Simplify

Holoraumy

ϕHolo[Rep]=Sum[-2 γ5γdown[mu]ϵdownupupup[mu,ro,sg,ta]D[Bmn[sg,ta][t,x,y,z],Ϛ[ro]],{mu,0,3},{ro,0,3},{sg,0,3},{ta,0,3}];

HoloraumyDDTable[ϕ[t,x,y,z]]== ϕHolo[Rep]//Simplify

BmnHoloTerms[aa_,bb_,mu_,nu_]:=Sum[ϵ[mu,nu,ap,bt]γ5γdown[ap][[aa,bb]]UD[ϕ[t,x,y,z],Ϛ[bt]],{ap,0,3},{bt,0,3}]+Sum[(γ5γstdowndown[mu][[aa,bb]]ϵ[nu,ro,sg,ta]-γ5γstdowndown[nu][[aa,bb]]ϵ[mu,ro,sg,ta])UD[Bmnupup[sg,ta][t,x,y,z],Ϛ[ro]],{ro,0,3},{sg,0,3},{ta,0,3}]

Table[HoloraumyDD[Da[aa],Da[bb]][Bmn[mu,nu][t,x,y,z]],{aa,1,4},{bb,1,4},{mu,0,3},{nu,0,3}]==Table[BmnHoloTerms[aa,bb,mu,nu],{aa,1,4},{bb,1,4},{mu,0,3},{nu,0,3}]//Simplify

with 
and

FHoloTerms[mu_][aa_,bb_,cc_,dd_]:= - γ5γdown[mu][[aa,bb]]γ5[[cc,dd]]

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

DEqm[Rep] = Table[Sum[I γ[mu][[dd,ee]]D[χ[ee][t,x,y,z],Ϛ[mu]],{mu,0,3},{ee,1,4}],{dd,1,4}];

ZHoloTerms[aa_,bb_,cc_]:=Sum[(-2Cmetric[[aa,bb]]KroneckerDelta[cc,dd]+2  γ5down[[aa,bb]]γ5[[cc,dd]] )DEqm[Rep][[dd]],{dd,1,4}]

ZHolo[Rep]=Table[ZHoloTerms[aa,bb,cc],{aa,1,4},{bb,1,4},{cc,1,4}];

Table[HoloraumyDD[Da[aa],Da[bb]][χ[cc][t,x,y,z]],{aa,1,4},{bb,1,4},{cc,1,4}]==(-2I Table[Sum[FHolo[Rep][mu][[aa,bb,cc,dd]]D[χ[dd][t,x,y,z],Ϛ[mu]],{mu,0,3},{dd,1,4}],{aa,1,4},{bb,1,4},{cc,1,4}]-ZHolo[Rep])//Simplify

Diagonal Lagrangian
ℒ = -(1/2)(∂_μ)ϕ(∂^μ)ϕ-(2/3) (Subscript[H, αμν])(H^(αμν))+ i (1/2) (((Subscript[χ, a])((γ^μ)))^ab)(∂_μ)(Subscript[χ, b])   
(Subscript[D, c])ℒ = 0  =  ((Subscript[D, c])ϕ)(∂_μ)(∂^μ)ϕ+2 ((Subscript[D, c])(Subscript[B, μν]))(∂_α)(H^(αμν))  - i (Subscript[χ, a])((((γ^μ)))^ab)(∂_μ)((Subscript[D, c])(Subscript[χ, b]))

Integration by parts commands: Put all derivatives on the bosons

ByParts={  Derivative[0,0,0,1][χ[xp__]][t,x,y,z]efield__[t,x,y,z]-> -  χ[xp][t,x,y,z]D[efield[t,x,y,z],z],
Derivative[0,0,1,0][χ[xp__]][t,x,y,z]efield__[t,x,y,z]-> -  χ[xp][t,x,y,z]D[ efield[t,x,y,z],y],Derivative[0,1,0,0][χ[xp__]][t,x,y,z]efield__[t,x,y,z]-> -   χ[xp][t,x,y,z]D[ efield[t,x,y,z],x],Derivative[1,0,0,0][χ[xp__]][t,x,y,z]efield__[t,x,y,z]-> -   χ[xp][t,x,y,z]D[ efield[t,x,y,z],t]}

DLPhi =((Subscript[D, c])ϕ)(∂_μ)(∂^μ)ϕ

DLPhi =Table[ Da[ci][ϕ[t,x,y,z]]Lap[ϕ[t,x,y,z]],{ci,1,4}];

DLB =2 ((Subscript[D, c])(Subscript[B, μν]))(∂_α)(H^(αμν))

Hamnup[0,0,0][t,x,y,z]

DLB =2 Table[Sum[ Da[ci][Bmn[mu,nu][t,x,y,z]]D[Hamnup[ap,mu,nu][t,x,y,z],Ϛ[ap]],{ap,0,3},{mu,0,3},{nu,0,3}],{ci,1,4}];

Table[Sum[D[Hamnup[ap,mu,nu][t,x,y,z],Ϛ[ap]],{ap,0,3}],{mu,0,3},{nu,0,3}]

DLChi =  - i (Subscript[χ, a])((((γ^μ)))^ab)(∂_μ)((Subscript[D, c])(Subscript[χ, b]))

DLChi = Table[ - I Sum[χ[ai][t,x,y,z]γup[mu][[ai,bi]]D[Da[ci][χ[bi][t,x,y,z]],Ϛ[mu]],{ai,1,4},{bi,1,4},{mu,0,3}],{ci,1,4}];

Lagrangian invariance:

DLTotal=(DLPhi+DLB +DLChi);

DLFinal = Collect[DLTotal,{χ[_][t,x,y,z],Derivative[_,_,_,_][Bmn[_,_]][t,x,y,z],Bmn[_,_][t,x,y,z],Derivative[_,_,_,_][ϕ][t,x,y,z],ϕ[t,x,y,z]},Simplify]

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