Relativity Computations

You might restart your Mathematica notebook for each of these ``5 variations" (or Fünf Variationen as Beethoven would put it) new, as old variables might interfere when reused a second time in an other set-up. This should not take too long. Start the above 5 tune by Beethoven and try to finish with this PSet before the end of the play!


Variation 1 
r = {(5+2 Sin[v])*Cos[u], (5+2 Sin[v])*Sin[u], Cos[v]};
ru=D[r,u];rv=D[r,v];n=Cross[ru,rv];n=n/Sqrt[n.n];
nu=D[n,u];nv=D[n,v];drT={ru,rv};dr=Transpose[drT];
g=drT.dr;gi=Inverse[g];dnT={nu,nv};dn=Transpose[dnT];
h=-dnT.dr;  e=dnT.dn; K=Det[h]/Det[g];
f=FullSimplify[K*Sqrt[Det[g]]];
CheckGaussBonnet:=Integrate[f,{u,0,2Pi},{v,0,Pi}];

XX={u,v};X[a_]:=XX[[a]];d=2; G[a_,b_]:=g[[a,b]]; 
c[i_,j_,k_]:=(D[G[j,k],X[i]]+D[G[k,i],X[j]]-D[G[i,j],X[k]])/2;
Ch[i_,j_,k_]:=Sum[gi[[k,l]]*c[i,j,l],{l,d}]; 
Riemann[i_,k_,j_,s_]:=D[Ch[i,j,s],X[k]]-D[Ch[i,k,s],X[j]]+
   Sum[Ch[i,j,r]*Ch[r,k,s]-Ch[i,k,r]*Ch[r,j,s],{r,d}];
R[i_,k_]:=Sum[Riemann[i,j,k,j],{j,d}];
S = Sum[gi[[i,j]] R[i,j],{i,d},{j,d}];
Einstein[i_,j_]:=R[i,j]-S G[i,j]/2; 
Table[Simplify[Riemann[i,j,k,l]],{i,d},{j,d},{k,d},{l,d}]
Table[Simplify[Einstein[i,j]],{i,d},{j,d}]

Variation 2 
g={{-(1-2M/r), 0         ,    0   ,           0    },
   {       0 , (1-2M/r)^(-1), 0   ,           0    },
   {       0 , 0         ,    r^2 ,           0    },
   {       0 , 0         ,    0   , r^2*Sin[phi]^2 }};
gi=Simplify[Inverse[g]]; 
XX={t,r,phi,theta};X[a_]:=XX[[a]];d=4; G[a_,b_]:=g[[a,b]]; 
c[i_,j_,k_]:=(D[G[j,k],X[i]]+D[G[k,i],X[j]]-D[G[i,j],X[k]])/2;
Ch[i_,j_,k_]:=Sum[gi[[k,l]]*c[i,j,l],{l,d}]; 
Riemann[i_,k_,j_,s_]:=D[Ch[i,j,s],X[k]]-D[Ch[i,k,s],X[j]]+
       Sum[Ch[i,j,m]*Ch[m,k,s]-Ch[i,k,m]*Ch[m,j,s],{m,d}];
R[i_,k_]:=Sum[Riemann[i,j,k,j],{j,d}];
S = Sum[gi[[i,j]] R[i,j],{i,d},{j,d}];
Einstein[i_,j_]:=R[i,j]-S G[i,j]/2; 
Table[Simplify[Riemann[i,j,k,l]],{i,d},{j,d},{k,d},{l,d}]
Table[Simplify[Einstein[i,j]],{i,d},{j,d}]

Variation 3 
g={{-(1-2M/r + e^2/r^2), 0         ,    0   ,           0    },
   {       0 , (1-2M/r+e^2/r^2)^(-1), 0   ,           0    },
   {       0 , 0         ,    r^2 ,           0    },
   {       0 , 0         ,    0   , r^2*Sin[phi]^2 }};
gi=Simplify[Inverse[g]]; 
XX={t,r,phi,theta};X[a_]:=XX[[a]];d=4; G[a_,b_]:=g[[a,b]]; 
c[i_,j_,k_]:=(D[G[j,k],X[i]]+D[G[k,i],X[j]]-D[G[i,j],X[k]])/2;
Ch[i_,j_,k_]:=Sum[gi[[k,l]]*c[i,j,l],{l,d}]; 
Riemann[i_,k_,j_,s_]:=D[Ch[i,j,s],X[k]]-D[Ch[i,k,s],X[j]]+
       Sum[Ch[i,j,m]*Ch[m,k,s]-Ch[i,k,m]*Ch[m,j,s],{m,d}];
R[i_,k_]:=Sum[Riemann[i,j,k,j],{j,d}];
S = Sum[gi[[i,j]] R[i,j],{i,d},{j,d}];
Einstein[i_,j_]:=R[i,j]-S G[i,j]/2; 
Table[Simplify[Riemann[i,j,k,l]],{i,d},{j,d},{k,d},{l,d}]
Table[Simplify[Einstein[i,j]],{i,d},{j,d}]

Variation 4 
r={Cos[u] Cos[w],Sin[u] Cos[w], Cos[v] Sin[w],Sin[v] Sin[w]};
ru=D[r,u]; rv=D[r,v]; rw=D[r,w];   A=Transpose[{ru,rv,rw}]; 
g=Transpose[A].A;  gi=Inverse[g];  n=r; 
volume:=Integrate[Sqrt[Det[g]],{u,0,2Pi},{v,0,Pi},{w,-Pi/2,Pi/2}]
XX={u,v,w};X[a_]:=XX[[a]];d=3; G[a_,b_]:=g[[a,b]]; 
c[i_,j_,k_]:=(D[G[j,k],X[i]]+D[G[k,i],X[j]]-D[G[i,j],X[k]])/2;
Ch[i_,j_,k_]:=Sum[gi[[k,l]]*c[i,j,l],{l,d}]; 
Riemann[i_,k_,j_,s_]:=D[Ch[i,j,s],X[k]]-D[Ch[i,k,s],X[j]]+
   Sum[Ch[i,j,r]*Ch[r,k,s]-Ch[i,k,r]*Ch[r,j,s],{r,d}];
R[i_,k_]:=Sum[Riemann[i,j,k,j],{j,d}];
S = Sum[gi[[i,j]] R[i,j],{i,d},{j,d}];
Einstein[i_,j_]:=R[i,j]-S G[i,j]/2; 
Table[Simplify[Riemann[i,j,k,l]],{i,d},{j,d},{k,d},{l,d}]
Table[Simplify[Einstein[i,j]],{i,d},{j,d}]

Variation 5 
r = { Sin[v] Cos[u], Sin[v] Sin[u],Cos[v] + Log[Tan[v/2]]}; 
ru=D[r,u]; rv=D[r,v]; {{ru.ru,ru.rv},{rv.ru,rv.rv}}
ru=D[r,u];rv=D[r,v];n=Cross[ru,rv];n=n/Sqrt[n.n];
nu=D[n,u];nv=D[n,v];drT={ru,rv};dr=Transpose[drT];
g=drT.dr;gi=Inverse[g];dnT={nu,nv};dn=Transpose[dnT];
h=-dnT.dr;  e=dnT.dn; K=Det[h]/Det[g];
f=FullSimplify[K*Sqrt[Det[g]]];
CheckGaussBonnet:=Integrate[f,{u,0,2Pi},{v,0,Pi}];

XX={u,v};X[a_]:=XX[[a]];d=2; G[a_,b_]:=g[[a,b]]; 
c[i_,j_,k_]:=(D[G[j,k],X[i]]+D[G[k,i],X[j]]-D[G[i,j],X[k]])/2;
Ch[i_,j_,k_]:=Sum[gi[[k,l]]*c[i,j,l],{l,d}]; 
Riemann[i_,k_,j_,s_]:=D[Ch[i,j,s],X[k]]-D[Ch[i,k,s],X[j]]+
   Sum[Ch[i,j,r]*Ch[r,k,s]-Ch[i,k,r]*Ch[r,j,s],{r,d}];
R[i_,k_]:=Sum[Riemann[i,j,k,j],{j,d}];
S = Sum[gi[[i,j]] R[i,j],{i,d},{j,d}];
Einstein[i_,j_]:=R[i,j]-S G[i,j]/2; 
Table[Simplify[Riemann[i,j,k,l]],{i,d},{j,d},{k,d},{l,d}]
Table[Simplify[Einstein[i,j]],{i,d},{j,d}]
P.S. The Schwarzschild computer algebra computation appeared already (for one of the earliest Mathematica implementations) on page 97 of my text "Introduction to Geometry and geometric analysis" from the fall term 1995 taught at Caltech. But this code has been rewritten from scratch for this course (the old code had been written 29 years ago! ).