0
$\begingroup$

I'm not that great at using Mathematica so please bear with me. What I'm trying to do here is compute the coefficients of the metric tensor in 3D spherical coordinates, from which I'll construct the Christoffel symbols, Riemann and Ricci tensors. But, I'm having some problems when trying to make the metric tensor. I start with the formula for the position vector: $$\underline{\mathrm{r}}=(r\cos\theta\sin\phi,r\sin\theta\sin\phi,r\cos\phi)$$ Note I am using the $(r,\theta,\phi)$ (radial, azimuthal, polar) or mathematics convention. I implement this in my code as

p[r_, θ_, ϕ_] := {r*Cos[θ]*Sin[ϕ], 
  r*Sin[θ]*Sin[ϕ], r*Cos[ϕ]}

Obviously using p instead of r to avoid double usage. Now, the definition of the components of metric tensor is $$g_{ij}=\frac{\partial\underline{\mathrm{r}}}{\partial q^i}\boldsymbol{\cdot}\frac{\partial \underline{\mathrm{r}}}{\partial q^j}$$ So I implement this in my code as

g[i_, j_] := D[p[r, θ, ϕ], i].D[p[r, θ, ϕ], j]

Obviously we should get $g_{rr}=1$, $g_{\theta\theta}=r^2\sin^2\phi$, and $g_{\phi\phi}=r^2$. However, when I input g[r,r] Mathematica outputs 0. In fact, whenever I run any two blue colored arguments it outputs zero, never throwing an error. e.g, g[dog,cat] outputs 0. However, when I put in black colored arguments, it actually does something different. For instance when I input g[π, Zeta[3]] it outputs errors: "General: $\pi$ is not a valid variable" and the same for $\zeta(3)$. It then shows me the (obviously nonsense) output

\!\(
\*SubscriptBox[\(∂\), \(π\)]\({r\ Cos[θ]\ Sin[\
ϕ], r\ Sin[θ]\ Sin[ϕ], r\ Cos[ϕ]}\)\).\!\(
\*SubscriptBox[\(∂\), \(Zeta[
    3]\)]\({r\ Cos[θ]\ Sin[ϕ], 
   r\ Sin[θ]\ Sin[ϕ], r\ Cos[ϕ]}\)\)

However, if I just use the definition of the metric tensor rather than trying to input g[...], e.g, when I type in the code

D[p[r, θ, ϕ], θ].D[
  p[r, θ, ϕ], θ]

It outputs r^2 Cos[θ]^2 Sin[ϕ]^2 + r^2 Sin[θ]^2 Sin[ϕ]^2, which simplifies to $r^2\sin^2\phi$, as expected. What???

How can I get this to work as I intend it to?

EDIT: I tried the approach mentioned below, and it worked, but only once. Below is the code I'm now using:

p[r_, θ_, ϕ_] := {r*Cos[θ]*Sin[ϕ], 
  r*Sin[θ]*Sin[ϕ], r*Cos[ϕ]}
g[i_, j_] := 
 D[p[r, θ, ϕ], ToExpression[i]].D[p[r, θ, ϕ], 
   ToExpression[j]]

When I input g[θ, θ], it once again outputs 0. Am I doing something wrong?

EDIT 2: When I try to define the inverse metric and the Christoffel symbols and Riemann tensor, it suddenly breaks my original metric tensor. If I just start a new notebook and paste the code

p[r_, θ_, ϕ_] := {r*Cos[θ]*Sin[ϕ], 
  r*Sin[θ]*Sin[ϕ], r*Cos[ϕ]}
g[i_, j_] := 
 D[p[r, θ, ϕ], ToExpression[i]].D[p[r, θ, ϕ], 
   ToExpression[j]]

It works as expected. But when I instead type in the code

p[r_, θ_, ϕ_] := {r*Cos[θ]*Sin[ϕ], 
  r*Sin[θ]*Sin[ϕ], r*Cos[ϕ]}
g[i_, j_] := 
 D[p[r, θ, ϕ], ToExpression[i]].D[p[r, θ, ϕ], 
   ToExpression[j]]
Inverseg[i_, j_] := 
 Piecewise[{{1/g[i, j], g[i, j] != 0}, {0, g[i, j] = 0}}]
Γ[k_, i_, j_] := 
 Inverseg[k, k]*
  D[p[r, θ, ϕ], ToExpression[k]].D[
    D[p[r, θ, ϕ], ToExpression[i]], ToExpression[j]]
Riem[a_, b_, c_, d_] := 
 D[Γ[a, b, d], ToExpression[c]] - 
  D[Γ[a, b, c], ToExpression[d]] + 
  Sum[Γ[i, b, d]*Γ[a, i, 
     c], {i, {r, θ, ϕ}}] - 
  Sum[Γ[i, b, c]*Γ[a, i, 
     d], {i, {r, θ, ϕ}}]

And then run the command Γ[r, ϕ, ϕ] it outputs enter image description here Not the $-r$ that I want. Then, after this, when I try running the command g[r,r] it once again outputs 0. See picture below.

enter image description here

What the heck is happening?!

EDIT 3: The whole point of all this was to calculate the scalar curvature on a sphere. For those interested, here is a picture of the working code and output that gives the correct result:

scalar curvature

Giving the desired result of $2/r^2$. Thank you all so much for your help.

$\endgroup$
3
  • $\begingroup$ Perhaps something to do with Piecewise ? Am I using it correctly? $\endgroup$ – K.defaoite Dec 4 '20 at 17:50
  • 1
    $\begingroup$ Inverseg[i_, j_] := Piecewise[{{1/g[i, j], g[i, j] != 0}, {0, g[i, j] = 0}}]. See the single = in g[i, j] = 0? That's Set, not Equal (==). Happens. $\endgroup$ – eyorble Dec 5 '20 at 16:55
  • $\begingroup$ @eyorble I am so dumb... Thank you so much. $\endgroup$ – K.defaoite Dec 5 '20 at 17:45
2
$\begingroup$

You can tell mathematica to treat the input as an expression like this:

g[i_, j_] :=  D[p[r, θ, ϕ], ToExpression[i]].D[p[r, θ, ϕ], ToExpression[j]]

Alternatively you could treat the variables rather as indices, and do for example:

g[i_, j_] := Derivative[KroneckerDelta[i, 1], KroneckerDelta[i, 2],KroneckerDelta[i, 3]][p][r, θ, ϕ].Derivative[KroneckerDelta[j, 1],KroneckerDelta[j, 2], KroneckerDelta[j, 3]][p][r, θ, ϕ]

I believe both yield the desired result.

$\endgroup$
5
  • $\begingroup$ This worked a treat, thank you. I will accept your answer as soon as it lets me. $\endgroup$ – K.defaoite Dec 4 '20 at 16:35
  • $\begingroup$ I am once again having problems. the approach you suggested worked briefly, but mysteriously has stopped working. See my question for the update. $\endgroup$ – K.defaoite Dec 4 '20 at 16:49
  • $\begingroup$ Have you ran other lines of code? I'm curious to know what changed. $\endgroup$ – Roderic Dec 4 '20 at 17:05
  • $\begingroup$ That might have been it - I opened a new notebook and pasted the code in and it worked. Not really sure what went wrong previously $\endgroup$ – K.defaoite Dec 4 '20 at 17:34
  • $\begingroup$ There's a very weird thing happening where running certain commands is changing the definition of g. See update. $\endgroup$ – K.defaoite Dec 4 '20 at 17:49
0
$\begingroup$

I really don't understand what you are doing here though. You say:

Obviously we should get grr=1, gθθ=r2sin2ϕ, and gϕϕ=r2. However, when I input g[r,r] Mathematica outputs 0.

That's not the case! With your definitions:

ClearAll[p, g]
p[r_, θ_, ϕ_] := {r*Cos[θ]*Sin[ϕ], r*Sin[θ]*Sin[ϕ], r*Cos[ϕ]}
g[i_, j_] := D[p[r, θ, ϕ], i].D[p[r, θ, ϕ], j]

g[r, r] // Simplify   (* Out: 1            *)
g[θ, θ] // Simplify   (* Out: r^2 Sin[ϕ]^2 *)
g[ϕ, ϕ] // Simplify   (* Out: r^2          *)

These are exactly the output you wanted! Was there something wrong such as lingering definitions?

$\endgroup$
1
  • $\begingroup$ Yes, I think lingering definitions were part of the problem. As I said I'm very new to Mathematica. $\endgroup$ – K.defaoite Dec 5 '20 at 23:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.