egison-3.7.13: sample/math/geometry/ThurstonManifold.egi
(define $x~ [| θ₁ θ₂ θ₃ θ₄ |])
(define $g__
[|[| 1 0 0 0 |]
[| 0 1 0 0 |]
[| 0 0 (/ κ (sqrt β)) (/ (* -1 θ₂ κ) (sqrt β)) |]
[| 0 0 (/ (* -1 θ₂ κ) (sqrt β)) (/ (* '(+ 1 θ₂) κ) (sqrt β)) |]|])
;(define $g~~ (M.inverse g_#_#))
(define $g~~
[|[| 1 0 0 0 |]
[| 0 1 0 0 |]
[| 0 0 (/ '(+ 1 θ₂) (* κ (sqrt β))) (/ θ₂ (* (sqrt β) κ)) |]
[| 0 0 (/ θ₂ (* (sqrt β) κ)) (/ 1 (* (sqrt β) κ)) |]|])
(define $β '(+ 1 θ₂ (* -1 (** θ₂ 2))))
;(define $β (function [θ₂]))
(define $Γ~c_a_b
(. (/ 1 2)
g~c~e
(+ (∂/∂ g_b_e x~a)
(∂/∂ g_a_e x~b)
(* -1 (∂/∂ g_a_b x~e)))))
Γ~1_#_#
Γ~2_#_#
(define $R_i_j_k~l
(with-symbols {a}
(+ (- (∂/∂ Γ~l_j_k x~i) (∂/∂ Γ~l_i_k x~j))
(- (. Γ~l_i_a Γ~a_j_k) (. Γ~l_j_a Γ~a_i_k)))))
(define $J__
[|[| 0 1 0 0 |]
[| -1 0 0 0 |]
[| 0 0 0 κ |]
[| 0 0 (* -1 κ) 0 |]|])
(define $J_a~c (. J_a_b g~b~c))
(define $∇J_a_b_m
(with-symbols {n}
(- (∂/∂ J_a_b x~m)
(. Γ~n_m_a J_n_b)
(. Γ~n_m_b J_a_n))))
(define $∇J_a_b~c
(with-symbols {n}
(. ∇J_a_b_m g~m~c)))
(define $δ
(generate-tensor
(match-lambda [integer integer]
{[[$n ,n] 1]
[[_ _] 0]})
{5 5}))
(define $R'___~
(generate-tensor
(match-lambda [integer integer integer integer]
{
[[,1 ,1 _ _] 0]
[[_ _ ,1 ,1] 0]
[[,1 $b ,1 $d] (* -1 p^2 δ~(- b 1)_(- d 1))]
[[$a ,1 ,1 $d] (* p^2 δ~(- a 1)_(- d 1))] ; complemented by Egi
[[,1 $b $c ,1] (* -1 p^2 g_(- b 1)_(- c 1))]
[[$a ,1 $c ,1] (* p^2 g_(- a 1)_(- c 1))] ; complemented by Egi
[[,1 $b $c $d] (* -1 p ∇J_(- b 1)_(- c 1)_(- d 1))]
[[$a ,1 $c $d] (* p ∇J_(- a 1)_(- c 1)~(- d 1))] ; complemented by Egi
[[$a $b ,1 $d] (* -1 p ∇J_(- a 1)_(- b 1)~(- d 1))]
[[$a $b $c ,1] (* p ∇J_(- a 1)_(- b 1)_(- c 1))]
[[$a $b $c $d] (+ R_(- a 1)_(- b 1)_(- c 1)~(- d 1)
(* -1 p^2 J_(- b 1)_(- c 1) J_(- a 1)~(- d 1))
(* p^2 J_(- a 1)_(- c 1) J_(- b 1)~(- d 1))
(* 2 p^2 J_(- a 1)_(- b 1) J_(- c 1)~(- d 1)))]
})
{5 5 5 5}))
(define $S
(with-symbols {i j k}
(let {[[$es $os] (even-and-odd-permutations 5)]}
(- (sum (map (lambda [$σ] (debug (. R'_(σ 1)_j_1~i R'_(σ 2)_(σ 3)_k~j R'_(σ 4)_(σ 5)_i~k))) es))
(sum (map (lambda [$σ] (debug (. R'_(σ 1)_j_1~i R'_(σ 2)_(σ 3)_k~j R'_(σ 4)_(σ 5)_i~k))) os))))))
S