this just loads all the tensor package stuff

Quit[]

<<xAct`xTras`

here we are defining a manifold with dimension δ and a metric tensor that we call “metric”, it has covariant derivative “CD”

this is a nice replacement rule function

ApplyRule[expr_]:=MakeRule[Evaluate[List@@expr],MetricOn->All,ContractMetrics->True]

$CovDFormat="Prefix";

DefConstantSymbol[δ]

DefManifold[M,δ,IndexRange[a,z]]

DefMetric[1,G[-a,-b],CD,PrintAs->"g", SymbolOfCovD-> {";","∇"}];

3/2G[b,d](G[a,c](Antisymmetrize[CD[-e]@RiemannCD[-a,-b,-c,-d],{-e,-a,-b}]//CollectTensors)//CollectTensors)//CollectTensors

DefTensor[ϕ[],M,PrintAs-> "ϕ"]

DefConstantSymbol[ξ]

Sqrt[DetG[]]

Action =((1/2)G[a,b]CD[-a]@ϕ[]CD[-b]@ϕ[]+ (1/2)ξ RicciScalarCD[]((ϕ[])^2));

?VarD

?VarL

RicciScalarCD[]

RicciCD[-a,-b]

G[-a,-c]RiemannCD[a,b,c,d]//CollectTensors

2VarL[G[a,b]][Action]//CollectTensors

%16/.a->-a/.b->-b

DefTensor[T[a,b],M]

T[a_,b_]:=ξ ({{R[∇], ({{a, b}, { ,  }})}}) (ϕ^2)-(1/2) ξ ({{g, ({{b, a}, { ,  }})}}) R[∇] (ϕ^2)-ξ ϕ (∇^a)(∇^b)ϕ+(1-2 ξ) (∇^a)ϕ (∇^b)ϕ-ξ ϕ (∇^b)(∇^a)ϕ+2 ξ ({{g, ({{b, a}, { ,  }})}}) ϕ (Subscript[∇, c])(∇^c)ϕ+2 (-(1/4)+ξ) ({{g, ({{b, a}, { ,  }})}}) (Subscript[∇, c])ϕ (∇^c)ϕ;

T[-u,-v]

G[a,b](ξ ({{R[∇], ({{ ,  }, {a, b}})}}) (ϕ^2)-(1/2) ξ ({{g, ({{ ,  }, {a, b}})}}) R[∇] (ϕ^2)-ξ ϕ (Subscript[∇, a])(Subscript[∇, b])ϕ+(1-2 ξ) (Subscript[∇, a])ϕ (Subscript[∇, b])ϕ-ξ ϕ (Subscript[∇, b])(Subscript[∇, a])ϕ+2 ξ ({{g, ({{ ,  }, {a, b}})}}) ϕ (Subscript[∇, c])(∇^c)ϕ+2 (-(1/4)+ξ) ({{g, ({{ ,  }, {a, b}})}}) (Subscript[∇, c])ϕ (∇^c)ϕ)/.ξ-> ((δ-2)/(4(δ-1)))//CollectTensors

VarD[ϕ[],CD][Action]//CollectTensors

(G[a,b](ξ ({{R[∇], ({{ ,  }, {a, b}})}}) (ϕ^2)-(1/2) ξ ({{g, ({{ ,  }, {a, b}})}}) R[∇] (ϕ^2)-ξ ϕ (Subscript[∇, a])(Subscript[∇, b])ϕ+(1-2 ξ) (Subscript[∇, a])ϕ (Subscript[∇, b])ϕ-ξ ϕ (Subscript[∇, b])(Subscript[∇, a])ϕ+2 ξ ({{g, ({{ ,  }, {a, b}})}}) ϕ (Subscript[∇, c])(∇^c)ϕ+2 (-(1/4)+ξ) ({{g, ({{ ,  }, {a, b}})}}) (Subscript[∇, c])ϕ (∇^c)ϕ)//CollectTensors)/.ApplyRule[CD[-a]@CD[a]@ϕ[]== ξ RicciScalarCD[]ϕ[]]/.ξ-> ((δ-2)/(4(δ-1)))//CollectTensors

(CD[a]@((ξ ({{R[∇], ({{ ,  }, {a, b}})}}) (ϕ^2)-(1/2) ξ ({{g, ({{ ,  }, {a, b}})}}) R[∇] (ϕ^2)-ξ ϕ (Subscript[∇, a])(Subscript[∇, b])ϕ+(1-2 ξ) (Subscript[∇, a])ϕ (Subscript[∇, b])ϕ-ξ ϕ (Subscript[∇, b])(Subscript[∇, a])ϕ+2 ξ ({{g, ({{ ,  }, {a, b}})}}) ϕ (Subscript[∇, c])(∇^c)ϕ+2 (-(1/4)+ξ) ({{g, ({{ ,  }, {a, b}})}}) (Subscript[∇, c])ϕ (∇^c)ϕ))/.ApplyRule[CD[a]@RicciCD[-a,-b]== (1/2)CD[-b]@RicciScalarCD[]]//CollectTensors//SortCovDs)/.ApplyRule[CD[-a]@CD[a]@ϕ[]== ξ RicciScalarCD[]ϕ[]]//CollectTensors

CD[a]@((ξ ({{R[∇], ({{ ,  }, {a, b}})}}) (ϕ^2)-(1/2) ξ ({{g, ({{ ,  }, {a, b}})}}) R[∇] (ϕ^2)-ξ ϕ (Subscript[∇, a])(Subscript[∇, b])ϕ+(1-2 ξ) (Subscript[∇, a])ϕ (Subscript[∇, b])ϕ-ξ ϕ (Subscript[∇, b])(Subscript[∇, a])ϕ+2 ξ ({{g, ({{ ,  }, {a, b}})}}) ϕ (Subscript[∇, c])(∇^c)ϕ+2 (-(1/4)+ξ) ({{g, ({{ ,  }, {a, b}})}}) (Subscript[∇, c])ϕ (∇^c)ϕ))/.ApplyRule[CD[a]@RicciCD[-a,-b]== (1/2)CD[-b]@RicciScalarCD[]]/.ApplyRule[CD[-a]@CD[a]@ϕ[]== ξ RicciScalarCD[]ϕ[]]//CollectTensors//SortCovDs//CollectTensors//SortCovDs

Spin 2 on flat background -> Linearized Einstein equation

Quit[]

<<xAct`xTras`

ApplyRule[expr_]:=MakeRule[Evaluate[List@@expr],MetricOn->All,ContractMetrics->True]

DefConstantSymbol[δ]

DefManifold[M,δ,IndexRange[a,l]]

DefMetric[-1,G[-a,-b],PD,PrintAs->"η",FlatMetric->True, SymbolOfCovD-> {",","∂"}];

SetOptions[SymmetryOf,ConstantMetric->True]

We  define a symmetric spin 2 field

DefTensor[H[-a,-b],M,Symmetric[{-a,-b}],PrintAs->"h"]

And  a gauge vector

DefTensor[χ[a],M,PrintAs-> "χ"]

We  can  now construct all possible terms for the action, and generate the most general Ansatz. As we do not care about total derivatives, we can just consider terms as h ∂ ∂ h. These are all the terms

Sterms = AllContractions[H[a,b]PD[c]@PD[d]@H[e,f]]

S=MakeAnsatz[Sterms]

The  equation of motion are

eom = VarD[H[-a,-b],PD][S]//CollectTensors//SortCovDs

The  gauge transformation that we want are

δH = 2 Symmetrize[PD[-a]@χ[-b]]

We  can force the action to have such gauge transformations

DefConstantSymbol[ϵ]

S/.ApplyRule[H[-a,-b]== H[-a,-b] + ϵ δH]//Expand

S/.ApplyRule[H[-a,-b]== H[-a,-b] + ϵ δH]//SeriesCoefficient[#,{ϵ,0,1}]&//CollectTensors//VarD[χ[-a],PD][#]&//CollectTensors//SolveConstants[#==0]&

Another  way to do the same thing is the compute the gauge variation of the action δS to be

δS = δH eom//CollectTensors

Up  to  total derivatives, this should be zero. We can eliminate total derivatives by removing all derivatives from the gauge parameter with the help of VarD

δS = χ[a] VarD[χ[a],PD][δS]//CollectTensors

Solve  for  the constants

sols = SolveConstants[δS==0]

Plug  this back into the action

S/.First[sols]

The  coefficient C2 parameterizes an overall normalization, and the coefficient C1 is a total derivative. Indeed, C1 does not appear in the final equation of motions

eom/.First[sols]

eom/.First[sols]/.C2->1

This  is precisely the linearized Einstein equation.

Vary  an  action in curved space

Quit[]

<<xAct`xTras`

ApplyRule[expr_]:=MakeRule[Evaluate[List@@expr],MetricOn->All,ContractMetrics->True]

$CovDFormat="Prefix";

DefConstantSymbol[δ]

DefManifold[M,δ,IndexRange[a,l]]

DefMetric[1,G[-a,-b],CD,PrintAs->"g", SymbolOfCovD-> {";","∇"}];

RiemannCD[a,b,c,d]+RiemannCD[b,a,c,d]//CollectTensors

Antisymmetrize[RiemannCD[a,b,c,d],{a,b,c}]//CollectTensors

this is a 2-index tensor that we will use as our perturbation

DefTensor[H[-a,-b],M,Symmetric[{-a,-b}],PrintAs->"h"]

this is a constant we will use as a formal expansion parameter

DefConstantSymbol[α]

this xpert package is the one that actually perturbs stuff

<<xAct`xPert`

this package lets you export things as LaTeX

<<xAct`TexAct`

these are just some functions that make things appear cleaner.

Unprotect[IndexForm];
IndexForm[LI[x_]]:=ColorString[ToString[x],RGBColor[0,0,1]];
Protect[IndexForm];

DefMetricPerturbation[G,metG,ϵ];
PrintAs[metG]^="h";

in general xPert will allow higher-order perturbations (things that start at higher order in some formal counting parameter), but we will only work with a perturbation that is first order in this counting parameter

firstorderonly=metG[LI[n_],__]:>0/;n>1;

Fpert0=Perturbation[F[],n_]:>0/;n>0;

$CovDFormat="Prefix";

The Einstein-Hilbert action is the following:

DefConstantSymbol[ξ]

DefTensor[ϕ[],M]

DefConstantSymbol[Hubble]

EHaction=Sqrt[-DetG[]](((RicciScalarCD[])/2)-(((δ-1)(δ-2))/2)(Hubble^2));

we can perturb this to quadratic order (this can easily be done to higher order, just change 2 to a different number):

(Perturbed[EHaction,2]//ExpandPerturbation//CollectTensors)//.firstorderonly

this gives:

pertEH=%/.firstorderonly//CollectTensors

a linearized spin-2 is given by the quadratic stuff

Coefficient[%,(ϵ^2)]

the canonically normalized graviton can be written as

canonicalEH2=(1/(Sqrt[-DetG[]]))%/.ApplyRule[metG[LI[1],-f,-g]==2H[-f,-g]]//CollectTensors//SortCovDs//CollectTensors

this is on a totally general spacetime, but we can specialize to a maximally symmetric space:

dSriemann=RiemannCD[-a,-b,-c,-d]==(Hubble^2)(G[-a,-c]G[-b,-d]-G[-a,-d]G[-b,-c])

dSricci=RicciCD[a,b]==(δ-1)(Hubble^2)G[a,b]

dSricciS=RicciScalarCD[]==δ(δ-1)(Hubble^2)

canonicalEH2/.ApplyRule@dSriemann/.ApplyRule@dSricci/.ApplyRule@dSricciS//CollectTensors

We can derive the linearized Einstein equations for example:

VarD[H[a,b],CD][%]//CollectTensors//SortCovDs//CollectTensors

%/.ApplyRule@dSriemann/.ApplyRule@dSricci/.ApplyRule@dSricciS//CollectTensors