;;;
;;; Parameters
;;;

(define $x [|θ φ|])

(define $X [|(* r (sin θ) (cos φ)) ; = x
             (* r (sin θ) (sin φ)) ; = y
             (* r (cos θ))         ; = z
             |])

;;
;; Local basis
;;

(define $e_i_j (∂/∂ X_j x~i))
(assert-equal "Local basis"
  e_#_#
  [|[|(* r (cos θ) (cos φ)) (* r (cos θ) (sin φ)) (* -1 r (sin θ)) |]
    [|(* -1 r (sin θ) (sin φ)) (* r (sin θ) (cos φ)) 0 |]
    |]_#_#)

;;
;; Metric tensor
;;

(define $g__ (generate-tensor 2#(V.* e_%1_# e_%2_#) {2 2}))
(define $g~~ (M.inverse g_#_#))

(assert-equal "Metric tensor 1" g_#_# [| [| r^2 0 |] [| 0 (* r^2 (sin θ)^2) |] |]_#_#)
(assert-equal "Metroc tensor 2" g~#~# [| [| (/ 1 r^2) 0 |] [| 0 (/ 1 (* r^2 (sin θ)^2)) |] |]~#~#)

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

(define $Γ_j_k_l
  (* (/ 1 2)
     (+ (∂/∂ g_j_l x~k)
        (∂/∂ g_j_k x~l)
        (* -1 (∂/∂ g_k_l x~j)))))

(assert-equal "Christoffel symbols of the first kind" Γ_#_#_# (tensor {2 2 2} {0 0 0 (* -1 r^2 (sin θ) (cos θ)) 0 (* r^2 (sin θ) (cos θ)) (* r^2 (sin θ) (cos θ)) 0} )_#_#_#)
(assert-equal "Christoffel symbols of the first kind" Γ_1_#_# [| [| 0 0 |] [| 0 (* -1 r^2 (sin θ) (cos θ)) |] |]_#_#)
(assert-equal "Christoffel symbols of the first kind" Γ_2_#_# [| [| 0 (* r^2 (sin θ) (cos θ)) |] [| (* r^2 (sin θ) (cos θ)) 0 |] |]_#_#)

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

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

(assert-equal "Christoffel symbols of the second kind" Γ~#_#_# (tensor {2 2 2} {0 0 0 (* -1 (sin θ) (cos θ)) 0 (/ (cos θ) (sin θ)) (/ (cos θ) (sin θ)) 0} )~#_#_#)
(assert-equal "Christoffel symbols of the second kind" Γ~1_#_# [| [| 0 0 |] [| 0 (* -1 (sin θ) (cos θ)) |] |]_#_#)
(assert-equal "Christoffel symbols of the second kind" Γ~2_#_# [| [| 0 (/ (cos θ) (sin θ)) |] [| (/ (cos θ) (sin θ)) 0 |] |]_#_#)

;;
;; Covariant derivative of metric tensor
;;
(define $∇g___
  (with-symbols {i j m n}
    (- (∂/∂ g_i_j x~m)
       (. Γ~n_m_i g_n_j)
       (. Γ~n_m_j g_i_n))))

(assert-equal "Covariant derivative of metric tensor" ∇g_#_#_# (tensor {2 2 2} {0 0 0 0 0 0 0 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)))))

(assert-equal "Riemann curvature" R~#_#_#_# (tensor {2 2 2 2} {0 0 0 0 0 (sin θ)^2 (* -1 (sin θ)^2) 0 0 -1 1 0 0 0 0 0} )~#_#_#_#)
(assert-equal "Riemann curvature" R~#_#_1_1 [| [| 0 0 |] [| 0 0 |] |]~#_#)
(assert-equal "Riemann curvature" R~#_#_1_2 [| [| 0 (sin θ)^2 |] [| -1 0 |] |]~#_#)
(assert-equal "Riemann curvature" R~#_#_2_1 [| [| 0 (* -1 (sin θ)^2) |] [| 1 0 |] |]~#_#)
(assert-equal "Riemann curvature" R~#_#_2_2 [| [| 0 0 |] [| 0 0 |] |]~#_#)

(define $R____ (with-symbols {i} (. g_i_# R~i_#_#_#)))

(assert-equal "Riemann curvature" R_#_#_#_# (tensor {2 2 2 2} {0 0 0 0 0 (* r^2 (sin θ)^2) (* -1 r^2 (sin θ)^2) 0 0 (* -1 r^2 (sin θ)^2) (* r^2 (sin θ)^2) 0 0 0 0 0} )_#_#_#_#)
(assert-equal "Riemann curvature" R_#_#_1_1 [| [| 0 0 |] [| 0 0 |] |]_#_#)
(assert-equal "Riemann curvature" R_#_#_1_2 [| [| 0 (* r^2 (sin θ)^2) |] [| (* -1 r^2 (sin θ)^2) 0 |] |]_#_#)
(assert-equal "Riemann curvature" R_#_#_2_1 [| [| 0 (* -1 r^2 (sin θ)^2) |] [| (* r^2 (sin θ)^2) 0 |] |]_#_#)
(assert-equal "Riemann curvature" R_#_#_2_2 [| [| 0 0 |] [| 0 0 |] |]_#_#)

;;
;; Ricci curvature
;;

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

(assert-equal "Ricci curvature" Ric_#_# [| [| 1 0 |] [| 0 (sin θ)^2 |] |]_#_#)

;;
;; Scalar curvature
;;

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

(assert-equal "Scalar curvature" scalar-curvature (/ 2 r^2))

;;
;; Covariant derivative of Riemann curvature tensor
;;

(define $∇R_____
  (with-symbols {i j k l m n}
    (- (∂/∂ R_i_j_k_l x~m)
       (. Γ~n_m_i R_n_j_k_l)
       (. Γ~n_m_j R_i_n_k_l)
       (. Γ~n_m_k R_i_j_n_l)
       (. Γ~n_m_l R_i_j_k_n))))

(assert-equal "Covariant derivative of Riemann curvature tensor"
  ∇R_#_#_#_#_#
  (tensor {2 2 2 2 2} {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} )_#_#_#_#_#)