Skip to main content
1 of 2
Mark Pace
  • 316
  • 1
  • 12

There might be some extra bits feel free to remove

   ClearAll["Global`*"];

n = 4;
coord = {t, x, y, z};

(*For raising/lowering latin indices like a, b, ...*)
\[Eta] = {{-1, 0, 0, 0}, {0, 1, 0, 0}, {0, 0, 1, 0}, {0, 0, 0, 1}};
\[Eta] // MatrixForm;
inveta = Inverse[\[Eta]];
inveta // MatrixForm;

(*"e-Metric";*)
e = {{\[ScriptCapitalN][t], 0, 0, 0}, {0, \[ScriptA][t], 0, 0}, {0, 
    0, \[ScriptA][t], 0}, {0, 0, 0, \[ScriptA][t]}};
\[ScriptCapitalN][t] = -1;
e // MatrixForm;
dete = Det[e];
(*Inverse e-Metric*)
inve = Inverse[e];
inve // MatrixForm;
detinve = Det[inve];

g := g = Simplify[Table[
    ParallelSum[ \[Eta][[a, b]]*e[[a, \[Mu]]]*e[[b, \[Nu]]]
     , {a, 1, n}, {b, 1, n}]
    , {\[Mu], 1, n}, {\[Nu], 1, n}]]
g // MatrixForm;
(*g is used to LOWER indices for Greek indices \[Mu], \[Nu]*)
invg = Inverse[g];
invg // MatrixForm;
(*invg is used to RAISE indices for Greek indices \[Mu], \[Nu]*)

(* In the form \[CapitalGamma]^{x}_{xx}*)
affine := affine = Simplify[Table[(1/2)*Sum[(invg[[i, s]])*
        (D[g[[s, j]], coord[[k]] ] +
          D[g[[s, k]], coord[[j]] ] - D[g[[j, k]], coord[[s]] ]), {s, 
        1, n}],
     {i, 1, n}, {j, 1, n}, {k, 1, n}] ];
listaffine := 
  Table[If[UnsameQ[affine[[i, j, k]], 
     0], {ToString[\[CapitalGamma][i, j, k]], 
     affine[[i, j, k]]}] , {i, 1, n}, {j, 1, n}, {k, 1, j}];
TableForm[Partition[DeleteCases[Flatten[listaffine], Null], 2], 
  TableSpacing -> {2, 2}];

(* In the form R^{x}_{xxx} *)
riemann := riemann = Simplify[Table[
     D[affine[[i, j, l]], coord[[k]] ] - 
      D[affine[[i, j, k]], coord[[l]] ] +
      Sum[
       affine[[s, j, l]] affine[[i, k, s]] - 
        affine[[s, j, k]] affine[[i, l, s]],
       {s, 1, n}],
     {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1, n}] ];
listriemann := 
 Table[If[UnsameQ[riemann[[i, j, k, l]], 0], {ToString[R[i, j, k, l]],
     riemann[[i, j, k, l]]}] , {i, 1, n}, {j, 1, n}, {k, 1, n}, {l, 1,
    k - 1}]
TableForm[Partition[DeleteCases[Flatten[listriemann], Null], 2], 
  TableSpacing -> {2, 2}];

(* In the form R_{xxxx} *)
riemann1 := riemann1 = Simplify[Table[
    Sum[
     g[[\[Mu], \[Mu]1]]*riemann[[\[Mu]1, \[Nu], \[Rho], \[Sigma]]]
     , {\[Mu]1, 1, n}]
    , {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, n}]]
listriemann1 := 
  Table[If[UnsameQ[riemann1[[\[Mu], \[Nu], \[Rho], \[Sigma]]], 
     0], {ToString[R1[\[Mu], \[Nu], \[Rho], \[Sigma]]], 
     riemann1[[\[Mu], \[Nu], \[Rho], \[Sigma]]]}] , {\[Mu], 1, 
    n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, \[Rho] - 1}];
TableForm[Partition[DeleteCases[Flatten[listriemann1], Null], 2], 
  TableSpacing -> {2, 2}];

(* In the form R^{xxxx} *)
riemann2 := riemann2 = Simplify[Table[
    Sum[
     Sum[
      Sum[
       invg[[\[Nu]1, \[Nu]]]*invg[[\[Rho]1, \[Rho]]]*
        invg[[\[Sigma]1, \[Sigma]]]*
        riemann[[\[Mu], \[Nu]1, \[Rho]1, \[Sigma]1]]
       , {\[Nu]1, 1, n}]
      , {\[Rho]1, 1, n}]
     , {\[Sigma]1, 1, n}]
    , {\[Mu], 1, n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, n}]]
listriemann2 := 
  Table[If[UnsameQ[riemann2[[\[Mu], \[Nu], \[Rho], \[Sigma]]], 
     0], {ToString[R2[\[Mu], \[Nu], \[Rho], \[Sigma]]], 
     riemann2[[\[Mu], \[Nu], \[Rho], \[Sigma]]]}] , {\[Mu], 1, 
    n}, {\[Nu], 1, n}, {\[Rho], 1, n}, {\[Sigma], 1, \[Rho] - 1}];
TableForm[Partition[DeleteCases[Flatten[listriemann2], Null], 2], 
  TableSpacing -> {2, 2}];

KretschmannScalar = Simplify[
  Sum[riemann1[[a, b, c, d]]*riemann2[[a, b, c, d]], {a, 1, n}, {b, 1,
     n}, {c, 1, n}, {d, 1, n}]]

With that input metric I got this answer:

$\frac{12 \left(\mathit{a}(t)^2 \mathit{a}''(t)^2+\mathit{a}'(t)^4\right)}{\mathit{a}(t)^4}$

Mark Pace
  • 316
  • 1
  • 12