egison-3.7.11: sample/math/geometry/riemann-curvature-tensor-of-S5-weyl.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 η) (cos ζ))
(* r (sin θ) (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 η) (cos ζ)) (* r (cos θ) (sin φ) (sin ψ) (sin η) (sin ζ)) |]
; [| 0 (* -1 r (sin θ) (sin φ)) (* r (sin θ) (cos φ) (cos ψ)) (* r (sin θ) (cos φ) (sin ψ) (cos η)) (* r (sin θ) (cos φ) (sin ψ) (sin η) (cos ζ)) (* r (sin θ) (cos φ) (sin ψ) (sin η) (sin ζ)) |]
; [| 0 0 (* -1 r (sin θ) (sin φ) (sin ψ)) (* r (sin θ) (sin φ) (cos ψ) (cos η)) (* r (sin θ) (sin φ) (cos ψ) (sin η) (cos ζ)) (* r (sin θ) (sin φ) (cos ψ) (sin η) (sin ζ)) |]
; [| 0 0 0 (* -1 r (sin θ) (sin φ) (sin ψ) (sin η)) (* r (sin θ) (sin φ) (sin ψ) (cos η) (cos ζ)) (* r (sin θ) (sin φ) (sin ψ) (cos η) (sin ζ)) |]
; [| 0 0 0 0 (* -1 r (sin θ) (sin φ) (sin ψ) (sin η) (sin ζ)) (* r (sin θ) (sin φ) (sin ψ) (sin η) (cos ζ)) |] |]
;;
;; Metric tensor
;;
(define $g__ (generate-tensor 2#(V.* e_%1 e_%2) {5 5}))
(define $g~~ (M.inverse g_#_#))
g_#_#
g~#~#
(with-symbols {i j k} (. g~i~j g_j_k))
;[| [| 1 0 0 0 0 |] [| 0 1 0 0 0 |] [| 0 0 1 0 0 |] [| 0 0 0 1 0 |] [| 0 0 0 0 1 |] |]
;;
;; Christoffel symbols of the first kind
;;
(define $Γ___
(with-symbols {j k l}
(* (/ 1 2)
(+ (∂/∂ g_j_l x~k)
(∂/∂ g_j_k x~l)
(* -1 (∂/∂ g_k_l x~j))))))
Γ_#_#_#
;;
;; Christoffel symbols of the second kind
;;
(define $Γ~__
(with-symbols {i j k l}
(. g~i~j Γ_j_k_l)))
Γ~#_#_#
;;
;; 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~#_#_#_#
;(tensor {5 5 5 5} {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 (* -1 (sin θ)^2) 0 0 0 (sin θ)^2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 1 0 0 0 -1 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 (* -1 (sin θ)^2 (sin φ)^2) 0 0 0 (* (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 1 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (sin θ)^2 0 0 0 (* -1 (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 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (sin θ)^2 0 0 0 0 0 0 0 (* -1 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2) 0 0 0 (* -1 (sin θ)^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 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 (sin θ)^2 0 0 0 0 0 0 0 0 0 0 0 (* -1 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 (* -1 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 (* -1 (sin θ)^2 (sin φ)^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} )~#_#_#_#
;;
;; Ricci curvature
;;
(define $Ric__ (with-symbols {i j k} (contract + R~i_j_k_i)))
Ric_#_#
;;
;; Scalar curvature
;;
(define $scalar-curvature (with-symbols {j k} (. g~j~k Ric_j_k)))
scalar-curvature
;;
;; Weyl curvature tensor
;;
(define $δ [| [| 1 0 0 0 0 |] [| 0 1 0 0 0 |] [| 0 0 1 0 0 |] [| 0 0 0 1 0 |] [| 0 0 0 0 1 |] |])
(define $Ric~_ (with-symbols {i k h} (. g~i~h Ric_k_h)))
(define $C~___
(with-symbols {i j k l}
(+ R~i_j_k_l
(* (/ -1 3) (+ (- (. δ~i_k Ric_j_l) (. δ~i_l Ric_j_k))
(- (. Ric~i_k g_j_l) (. Ric~i_l g_j_k))))
(* (/ scalar-curvature 12) (- (. δ~i_k g_j_l) (. δ~i_l g_j_k))))))
C~#_#_#_#
;(tensor {5 5 5 5} {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 (* -2 (sin θ)^2) 0 0 0 (* 2 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 2 0 0 0 -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 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2) 0 0 0 (* 2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 2 0 0 0 0 0 0 0 -2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2) 0 0 0 (* -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 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 -2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2) 0 0 0 0 0 0 0 (* -2 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2) 0 0 0 (* -2 (sin θ)^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 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2 (sin η)^2) 0 0 0 0 0 2 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -2 0 0 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 (* -2 (sin θ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 (* -2 (sin θ)^2 (sin φ)^2) 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 (* 2 (sin θ)^2 (sin φ)^2 (sin ψ)^2) 0 0 0 (* -2 (sin θ)^2 (sin φ)^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} )~#_#_#_#
;;
;; Wodzicki-Chern-Simons class
;;
(let {[[$es $os] (even-and-odd-permutations 5)]}
(- (sum' (map (lambda [$σ] (.' C~u_1_s_(σ 1) C~s_t_(σ 3)_(σ 2) C~t_u_(σ 5)_(σ 4))) es))
(sum' (map (lambda [$σ] (.' C~u_1_s_(σ 1) C~s_t_(σ 3)_(σ 2) C~t_u_(σ 5)_(σ 4))) os))))
;0