Problems calculating scalar curvature of sphere

Question

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 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.

Answer 1

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.

Answer 2

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?