Riemann curvature tensor – second kind

I followed these papers, very detailed references. We need metric \(g\) and \(g\)-inverse to get Christoffel symbols of second kind.

require(Deriv)
## Loading required package: Deriv
## Warning: package 'Deriv' was built under R version 4.0.5
dot_prod<-function(a,b){
 Simplify(paste(paste(a,b,sep="*"),collapse="+") )
}
g=matrix(c("1","0","0","sin(theta)^2"),nrow=2)
inv_g=matrix(c("1","0","0","1/sin(theta)^2"),nrow=2)

Gamma2nd<-function(k,i,j){
 para=c("theta","phi")
 g1=inv_g[k,]
 g2=sapply(g[i,],function(m) Deriv(m,para[j]))
 g3=sapply(g[,j],function(m) Deriv(m,para[i]))
 g4=sapply(para,function(m) Deriv(g[i,j],m))
 g5=sapply(paste(paste(g2,g3,sep="+"),g4,sep="-"),Simplify)

 res=Simplify(paste0(dot_prod(g1,g5),"/2"))
 return(res)
}

data=expand.grid(1:2,1:2,1:2)
Gamma <- array(apply(data,1,function(x) Gamma2nd(x[3],x[2],x[1])),dim = c(2, 2, 2))
Gamma
## , , 1
## 
##      [,1] [,2]                        
## [1,] "0"  "0"                         
## [2,] "0"  "-(cos(theta) * sin(theta))"
## 
## , , 2
## 
##      [,1]                    [,2]                   
## [1,] "0"                     "cos(theta)/sin(theta)"
## [2,] "cos(theta)/sin(theta)" "0"

Riemann curvature tensor second kind \[R^i_{\text{ }\text{ }jkm}=\Gamma^i_{jm,k}-\Gamma^i_{jk,m}+\Gamma^i_{nk}\Gamma^n_{jm}-\Gamma^i_{nm}\Gamma^n_{jk}\]

#riemann tensor

para=c("theta","phi")

Riemann2nd<-function(i,j,k,m){
 term1=Deriv(Gamma[j,m,i],para[k])
 term2=Deriv(Gamma[j,k,i],para[m])
 term2=paste0("-",term2)

 g3=Gamma[,k,i]
 g4=Gamma[j,m,]
 term3=dot_prod(g3,g4)

 g5=Gamma[,m,i]
 g6=Gamma[j,k,]
 term4=dot_prod(g5,g6)
 term4=paste0("-",term4)

 res=paste(term1,term2,term3,term4,sep="+")
 return(Simplify(res))
}

data=expand.grid(1:2,1:2,1:2,1:2)

R = apply(data,1,function(x) Riemann2nd(x[4],x[3],x[1],x[2]))
cbind(data,R)
##    Var1 Var2 Var3 Var4             R
## 1     1    1    1    1             0
## 2     2    1    1    1             0
## 3     1    2    1    1             0
## 4     2    2    1    1             0
## 5     1    1    2    1             0
## 6     2    1    2    1 -sin(theta)^2
## 7     1    2    2    1  sin(theta)^2
## 8     2    2    2    1             0
## 9     1    1    1    2             0
## 10    2    1    1    2             1
## 11    1    2    1    2            -1
## 12    2    2    1    2             0
## 13    1    1    2    2             0
## 14    2    1    2    2             0
## 15    1    2    2    2             0
## 16    2    2    2    2             0
R2nd=array(R,dim=c(2,2,2,2))
R2nd
## , , 1, 1
## 
##      [,1] [,2]
## [1,] "0"  "0" 
## [2,] "0"  "0" 
## 
## , , 2, 1
## 
##      [,1]            [,2]          
## [1,] "0"             "sin(theta)^2"
## [2,] "-sin(theta)^2" "0"           
## 
## , , 1, 2
## 
##      [,1] [,2]
## [1,] "0"  "-1"
## [2,] "1"  "0" 
## 
## , , 2, 2
## 
##      [,1] [,2]
## [1,] "0"  "0" 
## [2,] "0"  "0"

Ricci tensor by contraction \[R_{ij}=R^{\tau}_{\text{ }\text{ }ij\tau}\]

#tau=1:2
Ricci=sapply(paste(R2nd[1,,,1],R2nd[2,,,2],sep="+"),Simplify)
Ricci=matrix(Ricci,nrow = 2)
Ricci
##      [,1] [,2]          
## [1,] "1"  "0"           
## [2,] "0"  "sin(theta)^2"

Ricci scalar is \[R=g^{ij}R_{ij}\]

Ricci_scalar=sapply(paste(inv_g,Ricci,sep="*"),Simplify)
Ricci_scalar=Simplify(paste(Ricci_scalar,collapse="+"))
Ricci_scalar
## [1] "2"

The Riemann Curvature Tensor, Jennifer Cox, May 6, 2019

Geometry of the 2-sphere, Wheeler, October 28, 2010