egison-3.7.11: sample/math/geometry/riemann-curvature-tensor-of-S4.egi
;;;
;;; Parameters
;;;
(define $x [|θ φ ψ η|])
(define $X [|(* r (cos θ))
(* r (sin θ) (cos φ))
(* r (sin θ) (sin φ) (cos ψ))
(* r (sin θ) (sin φ) (sin ψ) (cos η))
(* r (sin θ) (sin φ) (sin ψ) (sin η))
|])
;;
;; Local basis
;;
(define $e ((flip ∂/∂) x~# X_#))
e
;[|[| (* -1 r (sin θ)) (* r (cos θ) (cos φ)) (* r (cos θ) (sin φ) (cos ψ)) (* r (cos θ) (sin φ) (sin ψ) (cos η)) (* r (cos θ) (sin φ) (sin ψ) (sin η)) |]
; [| 0 (* -1 r (sin θ) (sin φ)) (* r (sin θ) (cos φ) (cos ψ)) (* r (sin θ) (cos φ) (sin ψ) (cos η)) (* r (sin θ) (cos φ) (sin ψ) (sin η)) |]
; [| 0 0 (* -1 r (sin θ) (sin φ) (sin ψ)) (* r (sin θ) (sin φ) (cos ψ) (cos η)) (* r (sin θ) (sin φ) (cos ψ) (sin η)) |]
; [| 0 0 0 (* -1 r (sin θ) (sin φ) (sin ψ) (sin η)) (* r (sin θ) (sin φ) (sin ψ) (cos η)) |] |]_#~#
;;
;; Metric tensor
;;
(define $g__ (generate-tensor 2#(V.* e_%1 e_%2) {4 4}))
(define $g~~ (M.inverse g_#_#))
g_#_#;[| [| r^2 0 0 0 |] [| 0 (* r^2 (sin θ)^2) 0 0 |] [| 0 0 (* r^2 (sin θ)^2 (sin φ)^2) 0 |] [| 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) |] |]_#_#
g~#~#;[| [| (/ 1 r^2) 0 0 0 |] [| 0 (/ 1 (* r^2 (sin θ)^2)) 0 0 |] [| 0 0 (/ 1 (* r^2 (sin θ)^2 (sin φ)^2)) 0 |] [| 0 0 0 (/ 1 (* r^2 (sin θ)^2 (sin φ)^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 r^2 (sin (* 2 θ))) 2) 0 0 |] [| 0 0 (/ (* -1 r^2 (sin (* 2 θ)) (sin φ)^2) 2) 0 |] [| 0 0 0 (/ (* -1 r^2 (sin (* 2 θ)) (sin φ)^2 (sin ψ)^2) 2) |] |]_#_#
Γ_2_#_#;[| [| 0 (/ (* r^2 (sin (* 2 θ))) 2) 0 0 |] [| (/ (* r^2 (sin (* 2 θ))) 2) 0 0 0 |] [| 0 0 (/ (* -1 r^2 (sin θ)^2 (sin (* 2 φ))) 2) 0 |] [| 0 0 0 (/ (* -1 r^2 (sin θ)^2 (sin (* 2 φ)) (sin ψ)^2) 2) |] |]_#_#
Γ_3_#_#;[| [| 0 0 (/ (* r^2 (sin (* 2 θ)) (sin φ)^2) 2) 0 |] [| 0 0 (/ (* r^2 (sin θ)^2 (sin (* 2 φ))) 2) 0 |] [| (/ (* r^2 (sin (* 2 θ)) (sin φ)^2) 2) (/ (* r^2 (sin θ)^2 (sin (* 2 φ))) 2) 0 0 |] [| 0 0 0 (/ (* -1 r^2 (sin θ)^2 (sin φ)^2 (sin (* 2 ψ))) 2) |] |]_#_#
Γ_4_#_#;[| [| 0 0 0 (/ (* r^2 (sin (* 2 θ)) (sin φ)^2 (sin ψ)^2) 2) |] [| 0 0 0 (/ (* r^2 (sin θ)^2 (sin (* 2 φ)) (sin ψ)^2) 2) |] [| 0 0 0 (/ (* r^2 (sin θ)^2 (sin φ)^2 (sin (* 2 ψ))) 2) |] [| (/ (* r^2 (sin (* 2 θ)) (sin φ)^2 (sin ψ)^2) 2) (/ (* r^2 (sin θ)^2 (sin (* 2 φ)) (sin ψ)^2) 2) (/ (* r^2 (sin θ)^2 (sin φ)^2 (sin (* 2 ψ))) 2) 0 |] |]_#_#
;;
;; Christoffel symbols of the second kind
;;
(define $Γ~__ (with-symbols {i} (. g~#~i Γ_i_#_#)))
Γ~1_#_#;[| [| 0 0 0 0 |] [| 0 (/ (* -1 (sin (* 2 θ))) 2) 0 0 |] [| 0 0 (/ (* -1 (sin (* 2 θ)) (sin φ)^2) 2) 0 |] [| 0 0 0 (/ (* -1 (sin (* 2 θ)) (sin φ)^2 (sin ψ)^2) 2) |] |]_#_#
Γ~2_#_#;[| [| 0 (/ (cos θ) (sin θ)) 0 0 |] [| (/ (cos θ) (sin θ)) 0 0 0 |] [| 0 0 (/ (* -1 (sin (* 2 φ))) 2) 0 |] [| 0 0 0 (/ (* -1 (sin (* 2 φ)) (sin ψ)^2) 2) |] |]_#_#
Γ~3_#_#;[| [| 0 0 (/ (cos θ) (sin θ)) 0 |] [| 0 0 (/ (cos φ) (sin φ)) 0 |] [| (/ (cos θ) (sin θ)) (/ (cos φ) (sin φ)) 0 0 |] [| 0 0 0 (/ (* -1 (sin (* 2 ψ))) 2) |] |]_#_#
Γ~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 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 (* -1 (sin θ)^2) 0 0 |] [| 1 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_1_3;[| [| 0 0 (* -1 (sin θ)^2 (sin φ)^2) 0 |] [| 0 0 0 0 |] [| 1 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_1_4;[| [| 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2) |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| 1 0 0 0 |] |]~#_#
R~#_#_2_1;[| [| 0 (sin θ)^2 0 0 |] [| -1 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 (sin φ)^2) (* (cos θ)^2 (sin φ)^2)) 0 |] [| 0 (sin θ)^2 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_2_4;[| [| 0 0 0 0 |] [| 0 0 0 (+ (* -1 (sin φ)^2 (sin ψ)^2) (* (cos θ)^2 (sin φ)^2 (sin ψ)^2)) |] [| 0 0 0 0 |] [| 0 (sin θ)^2 0 0 |] |]~#_#
R~#_#_3_1;[| [| 0 0 (* (sin θ)^2 (sin φ)^2) 0 |] [| 0 0 0 0 |] [| -1 0 0 0 |] [| 0 0 0 0 |] |]~#_#
R~#_#_3_2;[| [| 0 0 0 0 |] [| 0 0 (+ (sin φ)^2 (* -1 (cos θ)^2 (sin φ)^2)) 0 |] [| 0 (* -1 (sin θ)^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 (sin ψ)^2) (* (cos θ)^2 (sin φ)^2 (sin ψ)^2) (* (cos φ)^2 (sin ψ)^2)) |] [| 0 0 (* (sin θ)^2 (sin φ)^2) 0 |] |]~#_#
R~#_#_4_1;[| [| 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2) |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| -1 0 0 0 |] |]~#_#
R~#_#_4_2;[| [| 0 0 0 0 |] [| 0 0 0 (+ (* (sin φ)^2 (sin ψ)^2) (* -1 (cos θ)^2 (sin φ)^2 (sin ψ)^2)) |] [| 0 0 0 0 |] [| 0 (* -1 (sin θ)^2) 0 0 |] |]~#_#
R~#_#_4_3;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 (+ (sin ψ)^2 (* -1 (cos θ)^2 (sin φ)^2 (sin ψ)^2) (* -1 (cos φ)^2 (sin ψ)^2)) |] [| 0 0 (* -1 (sin θ)^2 (sin φ)^2) 0 |] |]~#_#
R~#_#_4_4;[| [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] [| 0 0 0 0 |] |]~#_#
(define $R____ (with-symbols {i} (. g_i_# R~i_#_#_#)))
R_#_#_#_#;(tensor {4 4 4 4} {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^2) 0 0 (* r^2 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 (* r^2 (sin θ)^2) 0 0 (* -1 r^2 (sin θ)^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 0 (+ (* (cos θ)^2 (sin θ)^2 r^2 (sin φ)^2) (* -1 r^2 (sin θ)^2 (sin φ)^2)) 0 0 (+ (* -1 (cos θ)^2 (sin θ)^2 r^2 (sin φ)^2) (* r^2 (sin θ)^2 (sin φ)^2)) 0 0 0 0 0 0 0 0 0 0 0 0 0 (+ (* (cos θ)^2 (sin θ)^2 r^2 (sin φ)^2 (sin ψ)^2) (* -1 r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2)) 0 0 0 0 0 (+ (* -1 (cos θ)^2 (sin θ)^2 r^2 (sin φ)^2 (sin ψ)^2) (* r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2)) 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^4 (sin φ)^2) 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^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 0 (+ (* (cos θ)^2 (sin θ)^2 r^2 (sin φ)^4 (sin ψ)^2) (* -1 r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) (* r^2 (sin θ)^2 (sin φ)^2 (cos φ)^2 (sin ψ)^2)) 0 0 (+ (* -1 (cos θ)^2 (sin θ)^2 r^2 (sin φ)^4 (sin ψ)^2) (* r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) (* -1 r^2 (sin θ)^2 (sin φ)^2 (cos φ)^2 (sin ψ)^2)) 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^4 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^4 (sin φ)^4 (sin ψ)^2) 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^4 (sin ψ)^2) 0 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_#_#;[| [| 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
;;
(define $scalar-curvature (with-symbols {j k} (. g~j~k Ric_j_k)))
scalar-curvature;(/ 12 r^2)
;;
;; Covariant derivative of Ricci curvature
;;
(define $∇Ric___
(with-symbols {i j k l m n}
(- (∂/∂ Ric_i_j x~m)
(. Γ~n_m_i Ric_n_j)
(. Γ~n_m_j Ric_i_n)
)))
∇Ric_#_#_#
;(tensor {4 4 4} {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 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} )_#_#_#
;;
;; Conformal curvature tensor
;;
(define $C_i_k_l_m
(+ (. R_i_k_l_m)
(+ (- (. Ric_i_m g_k_l) (. Ric_i_l g_k_m))
(- (. Ric_k_l g_i_m) (. Ric_k_m g_i_l)))
(* (/ scalar-curvature 2) (- (. g_i_l g_k_m) (. g_i_m g_k_l)))))
C_#_#_#_#
;;(tensor {4 4 4 4} {0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^2) 0 0 (* -1 r^2 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 (* -1 r^2 (sin θ)^2) 0 0 (* r^2 (sin θ)^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 0 (* r^2 (sin θ)^4 (sin φ)^2) 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^4 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^2 (sin ψ)^2) 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^2) 0 0 (* r^2 (sin θ)^4 (sin φ)^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 0 (* r^2 (sin θ)^4 (sin φ)^4 (sin ψ)^2) 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^4 (sin ψ)^2) 0 0 0 0 (* -1 r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 (* r^2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 (* r^2 (sin θ)^4 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 r^2 (sin θ)^4 (sin φ)^4 (sin ψ)^2) 0 0 (* r^2 (sin θ)^4 (sin φ)^4 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0} )_#_#_#_#
;;
;; Pontryagin Class
;;
(define $P
(let {[[$es $os] (even-and-odd-permutations 4)]}
(- (sum (map (lambda [$σ] (. R~s_t_(σ 2)_(σ 1) R~t_s_(σ 4)_(σ 3))) es))
(sum (map (lambda [$σ] (. R~s_t_(σ 2)_(σ 1) R~t_s_(σ 4)_(σ 3))) os)))))
P;0