riemann-curvature-tensor-of-S4.egi

-- Parameters
def x : Vector MathValue := [| θ, φ, ψ, η |]

def X : Vector MathValue := [| r * cos θ
          , r * sin θ * cos φ
          , r * sin θ * sin φ * cos ψ
          , r * sin θ * sin φ * sin ψ * cos η
          , r * sin θ * sin φ * sin ψ * sin η
          |]

-- Local basis
def e_i_j : Matrix MathValue := ∂/∂ X_j x~i

-- Metric tensors
def g_i_j : Matrix MathValue := generateTensor (\[a, b] -> V.* e_a e_b) [4, 4]
def g~i~j : Matrix MathValue := M.inverse g_#_#

assertEqual "Metric tensor g_1_#"
  g_1_#
  [| r^2, 0, 0, 0 |]_#
assertEqual "Metric tensor g_2_#"
  g_2_#
  [| 0, r^2 * (sin θ)^2, 0, 0 |]_#
assertEqual "Metric tensor g_3_#"
  g_3_#
  [| 0, 0, r^2 * (sin θ)^2 * (sin φ)^2, 0 |]_#
assertEqual "Metric tensor g_4_#"
  g_4_#
  [| 0, 0, 0, r^2 * (sin θ)^2 * (sin φ)^2 * (sin ψ)^2 |]_#

-- Christoffel symbols
def Γ_i_j_k := (1 / 2) * (∂/∂ g_i_k x~j + ∂/∂ g_i_j x~k - ∂/∂ g_j_k x~i)

def Γ~i_j_k := withSymbols [m]
  g~i~m . Γ_m_j_k

assertEqual "Christoffel symbols of the second kind Γ~1_#_#"
  Γ~1_#_#
  [| [| 0, 0, 0, 0 |], [| 0, -1 * sin θ * cos θ, 0, 0 |], [| 0, 0, -1 * sin θ * cos θ * (sin φ)^2, 0 |], [| 0, 0, 0, -1 * sin θ * cos θ * (sin φ)^2 * (sin ψ)^2 |] |]_#_#
assertEqual "Christoffel symbols of the second kind Γ~2_#_#"
  Γ~2_#_#
  [| [| 0, (cos θ) / (sin θ), 0, 0 |], [| (cos θ) / (sin θ), 0, 0, 0 |], [| 0, 0, -1 * sin φ * cos φ, 0 |], [| 0, 0, 0, -1 * sin φ * cos φ * (sin ψ)^2 |] |]_#_#
assertEqual "Christoffel symbols of the second kind Γ~3_#_#"
  Γ~3_#_#
  [| [| 0, 0, (cos θ) / (sin θ), 0 |], [| 0, 0, (cos φ) / (sin φ), 0 |], [| (cos θ) / (sin θ), (cos φ) / (sin φ), 0, 0 |], [| 0, 0, 0, -1 * sin ψ * cos ψ |] |]_#_#
assertEqual "Christoffel symbols of the second kind Γ~4_#_#"
  Γ~4_#_#
  [| [| 0, 0, 0, (cos θ) / (sin θ) |], [| 0, 0, 0, (cos φ) / (sin φ) |], [| 0, 0, 0, (cos ψ) / (sin ψ) |], [| (cos θ) / (sin θ), (cos φ) / (sin φ), (cos ψ) / (sin ψ), 0 |] |]_#_#

-- Riemann curvature
def R~i_j_k_l := withSymbols [m]
  ∂/∂ Γ~i_j_l x~k - ∂/∂ Γ~i_j_k x~l + Γ~m_j_l . Γ~i_m_k - Γ~m_j_k . Γ~i_m_l

assertEqual "Riemann curvature R~#_#_1_1"
  R~#_#_1_1
  [| [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |] |]~#_#
assertEqual "Riemann curvature R~#_#_1_2"
  R~#_#_1_2
  [| [| 0, (sin θ)^2, 0, 0 |], [| -1, 0, 0, 0 |], [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |] |]~#_#
assertEqual "Riemann curvature R~#_#_2_1"
  R~#_#_2_1
  [| [| 0, -1 * (sin θ)^2, 0, 0 |], [| 1, 0, 0, 0 |], [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |] |]~#_#
assertEqual "Riemann curvature R~#_#_2_2"
  R~#_#_2_2
  [| [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |], [| 0, 0, 0, 0 |] |]~#_#

-- Ricci curvature
def Ric_i_j := withSymbols [m]
  sum (contract R~m_i_m_j)

assertEqual "Ricci curvature Ric_#_#"
  Ric_#_#
  [| [| 3, 0, 0, 0 |]
   , [| 0, 3 * (sin θ)^2, 0, 0 |]
   , [| 0, 0, 3 * (sin θ)^2 * (sin φ)^2, 0 |]
   , [| 0, 0, 0, 3 * (sin θ)^2 * (sin φ)^2 * (sin ψ)^2 |]
   |]_#_#

-- Scalar curvature
def scalarCurvature := withSymbols [i, j]
  g~i~j . Ric_i_j

assertEqual "scalar curvature"
  scalarCurvature
  (12 / r^2)