packages feed

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