How would I plot the metric $ds^2 =−(\phi^2 t^2)dt^2+dx^2+dy^2$ in Mathematica?

I've tried using:

ϕ = 1.9381 10^-14;
spaceRange = 5;
timeRange = 15000000;
ContourPlot3D[
x^2 + y^2 - ϕ^2 t^4 == 0, {x, -spaceRange,
spaceRange}, {y, -spaceRange, spaceRange}, {t, -timeRange,
timeRange}, ImageSize -> Large,
PlotRange -> {{-spaceRange, spaceRange}, {-spaceRange,
spaceRange}, {0, 15000000}}]


But I'm not absolutely sure I've captured the nature of the metric with this contour.

• Looks fine to me. – David G. Stork Aug 25 '18 at 1:29
• possible duplicate by OP: Is it possible to take the square root of this metric?. – AccidentalFourierTransform Aug 25 '18 at 2:24
• As I've said to you two times already, the contour plot you are using has nothing to do with your metric. $t^2$ is not the same thing as $\mathrm dt^2$, and $\vec r^2$ is not the same thing as $\mathrm d\vec r^2$. You take the metric $\sim -t^2\mathrm dt^2+\mathrm d\vec r^2$, and then plot the level-sets of $-t^4+\vec r^2$. Why? These two objects are not the same; in fact, they have nothing to do with each other. I don't know what your intention is, but why do you post questions if you are going to categorically ignore the responses you get? – AccidentalFourierTransform Aug 25 '18 at 2:27
• @AccidentalFourierTransform See my post below. The OP is not completely wrong with plotting this as a light cone. – Henrik Schumacher Aug 25 '18 at 13:34

dt = {1, 0, 0};
dx = {0, 1, 0};
dy = {0, 0, 1};
Quiet[dim = 3;
xx = Table[x[[i]], {i, 1, dim}];
uu = Table[u[[i]], {i, 1, dim}];
(*define the Lorentz metric (using ϕ=1)*)
g[x_] = -x[[1]]^2 TensorProduct[dt, dt] + TensorProduct[dx, dx] + TensorProduct[dy, dy];
Dg[x_] = D[g[xx], {xx, 1}];
ginv[x_] = Inverse[g[xx]];
(*compute Christoffel symbols by Koszul formula (needed for geodesic equation)*)
Block[{e = IdentityMatrix[dim]}, Γ[x_] =
Table[Sum[
1/2 (e[[k]].ginv[xx].e[[l]]) Plus[
+e[[j]].(e[[k]].Dg[xx]).e[[i]],
-e[[i]].(e[[j]].Dg[xx]).e[[k]],
+e[[i]].(e[[k]].Dg[xx]).e[[j]]
],
{k, 1, dim}], {i,1, dim}, {j, 1, dim}, {l, 1, dim}]
];
(*solve geodesic equation symbolically (will only work for very simple metric g;
NDSolve may help in the general case)*)
γ[τ_] =
Table[y[i][τ], {i, 1, dim}];
geodesic[x_, u_] = DSolveValue[
Join[
Thread[γ''[τ] + (Γ[γ[τ]].γ'[τ]).γ'[τ] == 0],
],
Table[y[i][τ], {i, 1, dim}],
τ
];

(*covariant derivative in operator form; in cov[X,Y],
vector field Y is derived in direction of vector field X*)
cov[X_, Y_] := x \[Function] Evaluate[D[X[xx], {xx, 1}].Y[xx] + (Γ[xx].Y[xx]).X[xx]];

(*Riemann curvature in operator form*)
riem[X_, Y_, Z_] := With[{
LieXY = x \[Function] Evaluate[D[Y[xx], {xx, 1}].X[xx] - D[X[xx], {xx, 1}].Y[xx]]
},
x \[Function] Evaluate[cov[X, cov[Y, Z]][xx] - cov[Y, cov[X, Z]][xx] - cov[LieXY, Z][xx]]
];

(*generate Riemann curvature tensor by testing operator form with coordinate vector fields*)
e = Table[x \[Function] Evaluate[IdentityMatrix[dim][[i]]], {i, 1, dim}];
R = x \[Function] Evaluate[Table[
riem[e[[i]], e[[j]], e[[k]]][xx].g[xx].e[[l]][xx],
{i, 1, dim}, {j, 1, dim}, {k, 1, dim}, {l, 1, dim}
] // Simplify];
];

(* routine for plotting the infinitesimal light cone at point {t,x,y}*)
infinitesimallightcone[{t_?NumericQ, x_?NumericQ, y_?NumericQ}] :=
ParametricPlot3D[
Evaluate[
Block[{v, w},
{t, x, y} + s {1, v Cos[ϕ], w Sin[ϕ]}/Sqrt[{1, v Cos[ϕ], w Sin[ϕ]}.{1, v Cos[ϕ], w Sin[ϕ]}]
/. Solve[({1, v, 0}).g[{t, x, y}].({1, v, 0}) == 0, v][[1]]
/. Solve[({1, 0, w}).g[{t, x, y}].({1, 0, w}) == 0, w][[1]]
]
],
{s, -r, r}, {ϕ, -Pi, Pi},
Mesh -> None,
PlotStyle -> Directive[ColorData[97][2], Opacity[0.6], Specularity[White, 30]],
Lighting -> "Neutral"
];


Plotting a light-like geodesic that emanates the origin (actually, geodesics starting from there are not well-defined), some infinitesimal light cones along its path (in yellow), and the one-sided (truncated) light cone at {0,0,0} (which actually is also not well-defined).

t00 = 3/2;
r = 1/20;
p[τ_] = Simplify[geodesic[{t00, 0, 0}, {-1, t00, 0}], 0 < τ < t00/2];
p[τ_] = p[τ] - p[t00/2];
Show[
ParametricPlot3D[
Evaluate[{p[τ][[1]], p[τ][[2]] Cos[ϕ], p[τ][[2]] Sin[ϕ]}],
{τ, 0, t00/2}, {ϕ, 0, 2 Pi},
PlotStyle -> Directive[ColorData[97][1], Opacity[0.6], Specularity[White, 30]],
BoundaryStyle -> Black,
PlotPoints -> {200, 72},
Lighting -> "Neutral"
],
infinitesimallightcone@*p /@ Subdivide[0, t00/2, 20],
Lighting -> "Neutral",
AxesOrigin -> {0, 0, 0},
AxesLabel -> {"t", "x", "y"}
]


This looks quite similar to the OP's plot. And actually, we have

p[τ][[2]]^2 + p[τ][[3]]^2 - 1/4 p[τ][[1]]^4 // Simplify


0

So, yes, OP's plot appears to be essentially correct (up to the factor 1/4 somewhere).

PS.: I tried to implement also the Riemannian curvature tensor. Apparently, it is equal to 0, so that the metric g is flat everywhere:

Max[Abs[R[xx]]]


That's no miracle because the metric g is obtained via pull-back of the (flat) Minkowski metric along the mapping

Quiet[Φ[x_] = {1/2 x[[1]]^2, x[[2]], x[[3]]}];


which can be checked as follows:

DΦ[x_] = D[Φ[xx], {xx, 1}];
DΦ[xx]\[Transpose].DiagonalMatrix[{-1, 1, 1}].DΦ[xx] == g[xx]


True

This mapping is a diffeomorphism from $]0,\infty[ \times \mathbb{R}^2{$ to $]0,\infty[ \times \mathbb{R}^2{$, and thus.

• Very nice (upvote). But is the use of XX instead of X on rhs of Dg and ginv intentional? – Daniel Lichtblau Aug 25 '18 at 14:37
• Thanks for the feedback, @Daniel! Yes, that's intended. XX evaluates to {X[[1]],X[[2]],X[[3]]}, so that the expressions can indeed be evaluated and simplified. That's also the reason for the Quiet: Mathematica complains otherwise about indexing into a undefined symbol. I prefer this approach over using {t,x,y} everywhere because it is easier to port to higher dimensions (just redefine dim and g; the computational parts should remain the same (untested)). – Henrik Schumacher Aug 25 '18 at 14:50
• That makes the produced code also easy to compile, which I do very often for numeric simulations (admittedly, rather for Riemannian manifolds than for Lorentzian ones). – Henrik Schumacher Aug 25 '18 at 14:50
• @HenrikSchumacher - This looks awesome and it will take me a little while to digest everything that you've done here. Using this metric, is a function available that will tell me the travel distance of a photon given the travel time? (This metric expands quadratically, so the photon will move through expanding space, like man walking against the direction of a moving sidewalk). – Quarkly Aug 25 '18 at 16:08
• @HenrikSchumacher - I had posted a response to the issue of machine precision, but I admit I don't understand all the operations going on. It could be that you're adding 1.0 so $\phi$ at some point, which would explain why you used unity units. Again, I have some follow up questions related to this space that are beyond the scope of this question. Connect with me through LinkedIn if you'd like to discuss further. – Quarkly Aug 28 '18 at 13:33