egison-3.7.8: sample/math/geometry/riemann-curvature-tensor-of-FLRW-metric.egi

;;;
;;; Parameters
;;;

(define $x [|w r θ φ|])

;;
;; Metric tensor
;;

(define $W (lambda [$r] (/ 1 '(- 1 (* K r^2)))))

(define $g__
  [|[| -1 0 0 0 |]
    [| 0 (* (`a w)^2 (W r)) 0 0 |]
    [| 0 0 (* (`a w)^2 r^2) 0 |]
    [| 0 0 0 (* (`a w)^2 r^2 (sin θ)^2) |]
    |])

(define $g~~ (M.inverse g_#_#))
g~#~#
;[|[| -1 0 0 0 |]
;  [| 0 (/ (* -1 '(+ 1 (* -1 K r^2))) (* -1 (a w)^2)) 0 0 |]
;  [| 0 0 (/ -1 (* -1 (a w)^2 r^2)) 0 |]
;  [| 0 0 0 (/ -1 (* -1 (a w)^2 r^2 (sin θ)^2)) |]|]~#~#

(with-symbols {i j k} (. g~i~j g_j_k))
;[| [| 1 0 0 0 |] [| 0 1 0 0 |] [| 0 0 1 0 |] [| 0 0 0 1 |] |]

;;
;; Christoffel symbols of the first kind
;;

(define $Γ_j_k_l
  (* (/ 1 2)
     (+ (∂/∂ g_j_k x_l)
        (∂/∂ g_j_l x_k)
        (* -1 (∂/∂ g_k_l x_j)))))

Γ_1_#_#;[| [| 0 0 0 0 |] [| 0 (/ (* -1 (a w) (a|1 w)) '(+ 1 (* -1 K r^2))) 0 0 |] [| 0 0 (* -1 (a w) (a|1 w) r^2) 0 |] [| 0 0 0 (* -1 (a w) (a|1 w) r^2 (sin θ)^2) |] |]_#_#
Γ_2_#_#;[| [| 0 (/ (* (a w) (a|1 w)) '(+ 1 (* -1 K r^2))) 0 0 |] [| (/ (* (a w) (a|1 w)) '(+ 1 (* -1 K r^2))) (/ (* K r (a w)^2) '(+ 1 (* -1 K r^2))^2) 0 0 |] [| 0 0 (* -1 (a w)^2 r) 0 |] [| 0 0 0 (* -1 (a w)^2 r (sin θ)^2) |] |]_#_#
Γ_3_#_#;[| [| 0 0 (* (a w) (a|1 w) r^2) 0 |] [| 0 0 (* (a w)^2 r) 0 |] [| (* (a w) (a|1 w) r^2) (* (a w)^2 r) 0 0 |] [| 0 0 0 (* -1 (a w)^2 r^2 (sin θ) (cos θ)) |] |]_#_#
Γ_4_#_#;[| [| 0 0 0 (* (a w) (a|1 w) r^2 (sin θ)^2) |] [| 0 0 0 (* (a w)^2 r (sin θ)^2) |] [| 0 0 0 (* (a w)^2 r^2 (sin θ) (cos θ)) |] [| (* (a w) (a|1 w) r^2 (sin θ)^2) (* (a w)^2 r (sin θ)^2) (* (a w)^2 r^2 (sin θ) (cos θ)) 0 |] |]_#_#

;;
;; Christoffel symbols of the second kind
;;

(define $Γ~__ (with-symbols {i} (. g~#~i Γ_i_#_#)))

Γ~1_#_#;[| [| 0 0 0 0 |] [| 0 (/ (* (a w) (a|1 w)) '(+ 1 (* -1 K r^2))) 0 0 |] [| 0 0 (* (a w) (a|1 w) r^2) 0 |] [| 0 0 0 (* (a w) (a|1 w) r^2 (sin θ)^2) |] |]_#_#
Γ~2_#_#;[| [| 0 (/ (* -1 (a|1 w)) (* -1 (a w))) 0 0 |] [| (/ (* -1 (a|1 w)) (* -1 (a w))) (/ (* -1 K r) (* -1 '(+ 1 (* -1 K r^2)))) 0 0 |] [| 0 0 (* -1 '(+ 1 (* -1 K r^2)) r) 0 |] [| 0 0 0 (* -1 '(+ 1 (* -1 K r^2)) r (sin θ)^2) |] |]_#_#
Γ~3_#_#;[| [| 0 0 (/ (* -1 (a|1 w)) (* -1 (a w))) 0 |] [| 0 0 (/ -1 (* -1 r)) 0 |] [| (/ (* -1 (a|1 w)) (* -1 (a w))) (/ -1 (* -1 r)) 0 0 |] [| 0 0 0 (* -1 (sin θ) (cos θ)) |] |]_#_#
Γ~4_#_#;[| [| 0 0 0 (/ (* -1 (a|1 w)) (* -1 (a w))) |] [| 0 0 0 (/ -1 (* -1 r)) |] [| 0 0 0 (/ (* -1 (cos θ)) (* -1 (sin θ))) |] [| (/ (* -1 (a|1 w)) (* -1 (a w))) (/ -1 (* -1 r)) (/ (* -1 (cos θ)) (* -1 (sin θ))) 0 |] |]_#_#

;;
;; Riemann curvature tensor
;;

(define $R~i_j_k_l
  (with-symbols {m}
    (+ (- (∂/∂ Γ~i_j_l x_k) (∂/∂ Γ~i_j_k x_l))
       (- (. Γ~m_j_l Γ~i_m_k) (. Γ~m_j_k Γ~i_m_l)))))

R~#_#_1_1;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_1_2;[| [| 0 (/ (* (a w) (a|1|1 w)) (+ -1 (* K r^2))) 0 0 |] [| (/ (* -1 (a|1|1 w)) (a w)) 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_1_3;[| [| 0 0 (* -1 (a w) (a|1|1 w) r^2) 0 |] [| 0 0 0 0 |] [| (/ (* -1 (a|1|1 w)) (a w)) 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_1_4;[| [| 0 0 0 (* -1 (a w) (a|1|1 w) r^2 (sin θ)^2) |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| (/ (* -1 (a|1|1 w)) (a w)) 0 0 0 |] |]~#_#
R~#_#_2_1;[| [| 0 (/ (* -1 (a w) (a|1|1 w)) (+ -1 (* K r^2))) 0 0 |] [| (/ (a|1|1 w) (a w)) 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_2_2;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_2_3;[| [| 0 0 0 0 |] [| 0 0 (+ (* -1 K r^2) (* -1 (a|1 w)^2 r^2)) 0 |] [| 0 (/ (+ (* -1 (a|1 w)^2) (* -1 K)) (+ -1 (* K r^2))) 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_2_4;[| [| 0 0 0 0 |] [| 0 0 0 (+ (* -1 K r^2 (sin θ)^2) (* -1 (a|1 w)^2 r^2 (sin θ)^2)) |] [| 0 0 0 0 |] [| 0 (/ (+ (* -1 (a|1 w)^2) (* -1 K)) (+ -1 (* K r^2))) 0 0 |] |]~#_#
R~#_#_3_1;[| [| 0 0 (* (a w) (a|1|1 w) r^2) 0 |] [| 0 0 0 0 |] [| (/ (a|1|1 w) (a w)) 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_3_2;[| [| 0 0 0 0 |] [| 0 0 (+ (* K r^2) (* (a|1 w)^2 r^2)) 0 |] [| 0 (/ (+ (a|1 w)^2 K) (+ -1 (* K r^2))) 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_3_3;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_3_4;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 (+ (* -1 (a|1 w)^2 r^2 (sin θ)^2) (* -1 K r^2 (sin θ)^2)) |] [| 0 0 (+ (* (a|1 w)^2 r^2) (* K r^2)) 0 |] |]~#_#
R~#_#_4_1;[| [| 0 0 0 (* (a w) (a|1|1 w) r^2 (sin θ)^2) |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| (/ (a|1|1 w) (a w)) 0 0 0 |] |]~#_#
R~#_#_4_2;[| [| 0 0 0 0 |] [| 0 0 0 (+ (* K r^2 (sin θ)^2) (* (a|1 w)^2 r^2 (sin θ)^2)) |] [| 0 0 0 0 |] [| 0 (/ (+ (a|1 w)^2 K) (+ -1 (* K r^2))) 0 0 |] |]~#_#
R~#_#_4_3;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 (+ (* (a|1 w)^2 r^2 (sin θ)^2) (* K r^2 (sin θ)^2)) |] [| 0 0 (+ (* -1 (a|1 w)^2 r^2) (* -1 K r^2)) 0 |] |]~#_#
R~#_#_4_4;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#

;;
;; Ricci curvature
;;

(define $Ric__ (with-symbols {i} (contract + R~i_#_i_#)))

Ric_1_#;[| (/ (* -3 (a|1|1 w)) (a w)) 0 0 0 |]_#
Ric_2_#;[| 0 (/ (+ (* -1 (a w) (a|1|1 w)) (* -2 (a|1 w)^2) (* -2 K)) (+ -1 (* K r^2))) 0 0 |]_#
Ric_3_#;[| 0 0 (+ (* (a w) (a|1|1 w) r^2) (* 2 K r^2) (* 2 (a|1 w)^2 r^2)) 0 |]_#
Ric_4_#;[| 0 0 0 (+ (* (a w) (a|1|1 w) r^2 (sin θ)^2) (* 2 K r^2 (sin θ)^2) (* 2 (a|1 w)^2 r^2 (sin θ)^2)) |]_#

;;
;; Scalar curvature
;;

(define $scalar-curvature (with-symbols {j k} (expand-all' (. g~j~k Ric_j_k))))

scalar-curvature
;(/ (+ (* 6 (a|1|1 w) (a w)) (* 6 (a|1 w)^2) (* 6 K))
;   (a w)^2)