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, 2020 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, 2020 at 16:55
  • $\begingroup$ @eyorble I am so dumb... Thank you so much. $\endgroup$
    – K.defaoite
    Dec 5, 2020 at 17:45

2 Answers 2

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, 2020 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, 2020 at 16:49
  • $\begingroup$ Have you ran other lines of code? I'm curious to know what changed. $\endgroup$
    – Roderic
    Dec 4, 2020 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, 2020 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, 2020 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, 2020 at 23:19

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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