トーラスのリーマン曲率テンソル

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

-- Parameters def x := [| θ, φ |] def X := [| `(a * cos θ + b) * cos φ -- x , `(a * cos θ + b) * sin φ -- y , a * sin θ -- z |] def e_i_j := ∂/∂ X_j x~i -- Metric tensors def g{_i_j} := generateTensor (\[x, y] -> V.* e_x_# e_y_#) [2, 2] def g{~i~j} := M.inverse g_#_# assertEqual "Metric tensor" g_#_# [| [| a^2, 0 |], [| 0, `(a * cos θ + b)^2 |] |]_#_# assertEqual "Metric tensor" g~#~# [| [| 1 / a^2, 0 |], [| 0, 1 / `(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)))

リンク

Egison 数学ノート目次に戻る