# Problems calculating scalar curvature of sphere

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] 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 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. 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: Giving the desired result of $$2/r^2$$. Thank you all so much for your help.

• Perhaps something to do with Piecewise ? Am I using it correctly? Dec 4, 2020 at 17:50
• 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. Dec 5, 2020 at 16:55
• @eyorble I am so dumb... Thank you so much. Dec 5, 2020 at 17:45

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.

• This worked a treat, thank you. I will accept your answer as soon as it lets me. Dec 4, 2020 at 16:35
• I am once again having problems. the approach you suggested worked briefly, but mysteriously has stopped working. See my question for the update. Dec 4, 2020 at 16:49
• Have you ran other lines of code? I'm curious to know what changed. Dec 4, 2020 at 17:05
• 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 Dec 4, 2020 at 17:34
• There's a very weird thing happening where running certain commands is changing the definition of g. See update. Dec 4, 2020 at 17:49

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?

• Yes, I think lingering definitions were part of the problem. As I said I'm very new to Mathematica. Dec 5, 2020 at 23:19