4次元超球面のリーマン曲率テンソル

以下のコードは、`S^4`のリーマン曲率テンソルを計算しています。

-- Parameters def x : Vector MathExpr := [| θ, φ, ψ, η |] def X : Vector MathExpr := [| r * cos θ , r * sin θ * cos φ , r * sin θ * sin φ * cos ψ , r * sin θ * sin φ * sin ψ * cos η , r * sin θ * sin φ * sin ψ * sin η |] -- Local basis def e : Matrix MathExpr := (flip ∂/∂) x~# X_# -- Metric tensors def g_i_j : Matrix MathExpr := generateTensor (\[a, b] -> V.* e_a e_b) [4, 4] def g~i~j : Matrix MathExpr := 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)

リンク

Egison 数学ノート目次に戻る