egison-5.1.0: sample/math/geometry/riemann-curvature-tensor-of-T2.egi

declare symbol a, b, θ, φ: MathValue

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

def X : Vector MathValue := [| `(a * cos θ + b) * cos φ -- x
          , `(a * cos θ + b) * sin φ -- y
          , a * sin θ                -- z
          |]

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

-- Metric tensors
def g[_i_j] : Matrix MathValue := generateTensor (\[x, y] -> V.* e_x_# e_y_#) [2, 2]
def g[~i~j] : Matrix MathValue := M.inverse g_#_#

assertEqual "Metric tensor"
  g_#_#
  [| [| a^2, 0 |], [| 0, `(a * cos θ + b)^2 |] |]_#_#
assertEqual "Metric tensor"
  g~#~#
  [| [| a^(-2), 0 |], [| 0, `(a * cos θ + b)^(-2) |] |]~#~#

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

assertEqual "Christoffel symbols of the first kind"
  Γ_1_#_#
  [| [| 0, 0 |], [| 0, `(a * cos θ + b) * a * sin θ |] |]_#_#
assertEqual "Christoffel symbols of the first kind"
  Γ_2_#_#
  [| [| 0, -1 * `(a * cos θ + b) * a * sin θ |], [| -1 * `(a * cos θ + b) * a * sin θ, 0 |] |]_#_#

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

assertEqual "Christoffel symbols of the second kind"
  Γ~1_#_#
  [| [| 0, 0 |], [| 0, `(a * cos θ + b) * sin θ / a |] |]_#_#
assertEqual "Christoffel symbols of the second kind"
  Γ~2_#_#
  [| [| 0, -1 * a * sin θ / `(a * cos θ + b) |], [| -1 * a * sin θ / `(a * cos θ + b), 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
  [| [| 0, 0 |], [| 0, 0 |] |]~#_#
assertEqual "riemann curvature"
  R~#_#_1_2
  [| [| 0, `(a * cos θ + b) * cos θ / a |], [| -1 * a * cos θ / `(a * cos θ + b), 0 |] |]~#_#
assertEqual "riemann curvature"
  R~#_#_2_1
  [| [| 0, -1 * `(a * cos θ + b) * cos θ / a |], [| a * cos θ / `(a * cos θ + b), 0 |] |]~#_#
assertEqual "riemann curvature"
  R~#_#_2_2
  [| [| 0, 0 |], [| 0, 0 |] |]~#_#

-- Riemann curvature 2
def R[{_i_j}{_k_l}] := withSymbols [m] g_i_m . R~m_j_k_l

assertEqual "riemann curvature"
  R_#_#_1_1
  [| [| 0, 0 |], [| 0, 0 |] |]_#_#
assertEqual "riemann curvature"
  R_#_#_1_2
  [| [| 0, a * `(a * cos θ + b) * cos θ |], [| - `(a * cos θ + b) * a * cos θ, 0 |] |]_#_#
assertEqual "riemann curvature"
  R_#_#_2_1
  [| [| 0, - a * `(a * cos θ + b) * cos θ |], [| `(a * cos θ + b) * a * cos θ, 0 |] |]_#_#
assertEqual "riemann curvature"
  R_#_#_2_2
  [| [| 0, 0 |], [| 0, 0 |] |]_#_#

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

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

assertEqual "scalar curvature"
  scalarCurvature
  (2 * cos θ / (a * `(a * cos θ + b)))