14
$\begingroup$

Taking the equation $x^2-y^2-z^2=1$ and using ContourPlot3D:

ContourPlot3D[
 x^2 - y^2 - z^2 == 1, {x, -3, 3}, {y, -3, 3}, {z, -3, 3}]

Yields the proper image.

enter image description here

Then I made substitutions and put it in spherical coordinate form. Note: Mathematica uses $\theta$ for the angle from the positive z-axis and $\phi$ for the angle of rotation in the xy-plane (or around the z-axis).

$$\begin{align*} x^2-y^2-z^2&=1\\ (\rho\sin\theta\cos\phi)^2-(\rho\sin\theta\sin\phi)^2-(\rho\cos\theta)^2&=1\\ \rho^2(\sin^2\theta\cos^2\phi-\sin^2\theta\sin^2\phi-\cos^2\theta)&=1\\ \rho^2(\sin^2\theta\cos 2\phi-\cos^2\theta)&=1 \end{align*}$$

Which gives:

$$\rho=\sqrt{\frac{1}{\sin^2\theta\cos2\phi-\cos^2\theta)}}$$

Now I gave SphericalPlot3D a chance:

SphericalPlot3D[Sqrt[1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)],
    {θ, π/4, 3 π/4}, {ϕ, -π/4, π/4}]

But look at the image:

enter image description here

Yuk! Any thoughts?

Great Answer from Simon Rochester

But there are still a couple of weird things going on that I don't understand.

Suppose we define our region function such that $0<r<7$.

SphericalPlot3D[Sqrt[1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)], 
 {θ, 0, π}, {ϕ, 0, 2 π}, MaxRecursion -> 4, 
 PlotRange -> {-3, 3}, 
 RegionFunction -> Function[{x, y, z, θ, ϕ, r}, 0 < r < 7]]

Look what happens.

enter image description here

Weird!

Secondly, consider the contour plot of $x^2-y^2=1$.

ContourPlot[x^2 - y^2 == 1, {x, -3, 3}, {y, -3, 3},
 Epilog -> {
   Red, Dashed,
   Line[{{-3, -3}, {3, 3}}],
   Line[{{-3, 3}, {3, -3}}]
   },
 Axes -> True,
 AxesLabel -> {"x", "y"}
 ]

enter image description here

Thus, you can see why I picked $\{\phi,-\pi/4,\pi/4\}$ for the right branch. Similarly, consider the contour plot of $x^2-z^2=1$.

ContourPlot[x^2 - z^2 == 1, {x, -3, 3}, {z, -3, 3},
 Epilog -> {
   Red, Dashed,
   Line[{{-3, -3}, {3, 3}}],
   Line[{{-3, 3}, {3, -3}}]
   },
 Axes -> True,
 AxesLabel -> {"x", "z"}
 ]

enter image description here

You can see why I picked $\{\theta,\pi/4,3\pi/4\}$ for the right branch. Thus, the domain for the right branch is $\{(\theta,\phi): \pi/4<\theta<3\pi/4\ \text{and}\ -\pi/4<\phi<\pi/4\}$. Yet:

SphericalPlot3D[Sqrt[1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)], 
 {θ, π/4,  3 π/4}, {ϕ, -π/4, π/4}, MaxRecursion -> 4, 
 PlotRange -> {-3, 3}, 
 RegionFunction ->  Function[{x, y, z, θ, ϕ, r}, 0 < r < 5]]

enter image description here

Still some strange stuff happening on the edges.

An answer to Simon Rochester's question in his latest comment

Consider:

func[θ_, ϕ_] =  Sqrt[1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)];
denom[θ_, ϕ_] = (Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2);
Show[
 SphericalPlot3D[If[denom[θ, ϕ] > 0, func[θ, ϕ], 10],
 {θ, π/4, 3 π/4}, {ϕ, -π/4, π/4},
  PlotPoints -> 30, PlotRange -> {-3, 3}, 
  RegionFunction -> Function[{x, y, z, θ, ϕ, r},denom[θ, ϕ] > 0]],
 SphericalPlot3D[If[denom[θ, ϕ] > 0, func[θ, ϕ], 10], 
{θ, π/4, 3 π/4}, {ϕ, 3 π/4, 5 π/4},
  PlotPoints -> 30, PlotRange -> {-3, 3}, 
  RegionFunction -> Function[{x, y, z, θ, ϕ, r},denom[θ, ϕ] > 0]]
 ]

Which produces this image:

enter image description here

Note the increase in meshes because of the restriction to the domain.

$\endgroup$
6
  • $\begingroup$ You can avoid pasting these \[Theta]-like sequences by converting them to their Unicode counterparts using this web app. $\endgroup$
    – Ruslan
    Jun 9, 2015 at 11:33
  • 1
    $\begingroup$ I updated my answer to try to address the plotting issues more thoroughly. But I don't think I understand the second part of your question about the domain of the right branch. What exactly is the issue there? $\endgroup$ Jun 10, 2015 at 2:59
  • $\begingroup$ @SimonRochester: An absolutely amazing investigation. I put a little update in my original post above to show my thought on the importance of the domain. Several things happen. Didn't have to use MaxRecursion, did not have to use 1000, just used PlotPoints->30. It compiles much faster and note that the default 15 meshes in both the $\theta$ and $\phi$ directions. $\endgroup$
    – David
    Jun 10, 2015 at 5:15
  • $\begingroup$ Thanks. Makes sense that restricting the plotting domain will concentrate the PlotPoints where they're actually needed. I didn't really need to choose 1000 in the first place, I just picked it to indicate that you could increase the PlotRange without too much problem. $\endgroup$ Jun 10, 2015 at 6:28
  • $\begingroup$ Your answer was awesome, a really cool bit of research. $\endgroup$
    – David
    Jun 10, 2015 at 15:55

2 Answers 2

22
$\begingroup$

SphericalPlot3D is having problems where the radius goes to infinity. You can use RegionFunction to restrict the plotting region to a range where the function is well-behaved:

SphericalPlot3D[
  Sqrt[1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)], {θ, 0, π}, {ϕ, 0, 2 π},
  MaxRecursion -> 4, PlotRange -> {-3, 3}, 
  RegionFunction -> Function[{x, y, z, θ, ϕ, r}, 0 < r < 5]
]

Mathematica graphics

There's still the question of where that extra garbage comes from and how to get rid of it more robustly, since it tends to reappear if we change the PlotRange, etc. First, note that it doesn't only appear in SphericalPlot3D. If we Plot3D the same function, we get:

 func[θ_, ϕ_] = Sqrt[1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)];
 Plot3D[func[θ, ϕ], {θ, 0, π}, {ϕ, 0, 2 π}, MaxRecursion -> 4, PlotRange -> {0, 3}]

Mathematica graphics

There are spurious zero values that appear where func should be imaginary and thus not plotted. If we try to restrict the plotting region to the range in which func is real using RegionFunction, it only gets worse:

denom[θ_, ϕ_] = (Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2);
Plot3D[func[θ, ϕ], {θ, 0, π}, {ϕ, 0, 2 π}, 
  MaxRecursion -> 4, PlotRange -> {0, 3}, 
  RegionFunction -> Function[{θ, ϕ, z}, denom[θ, ϕ] > 0]
]

Mathematica graphics

This seems like buggy behavior to me, since these spurious points are outside the region that we requested to be plotted. Increasing the WorkingPrecision doesn't seem to help.

Another approach to restricting the plotting region is to make the function evaluate to Null where it would be imaginary:

Plot3D[If[denom[θ, ϕ] > 0, func[θ, ϕ]], {θ, 0, π}, {ϕ, 0, 2 π}, 
  MaxRecursion -> 4, PlotRange -> {0, 3}
]

Mathematica graphics

Almost, but not quite. If we try both techniques together, though, it seems to work:

Plot3D[If[denom[θ, ϕ] > 0, func[θ, ϕ]], {θ, 0, π}, {ϕ, 0, 2 π},
  MaxRecursion -> 4, PlotRange -> {0, 3}, 
  RegionFunction -> Function[{θ, ϕ, z}, denom[θ, ϕ] > 0]
]

Mathematica graphics

Great, we might think, we've got a general solution -- let's try it with SphericalPlot3D:

SphericalPlot3D[If[denom[θ, ϕ] > 0, func[θ, ϕ]], 
  {θ, 0, π}, {ϕ, 0, 2 π}, 
  MaxRecursion -> 4, PlotRange -> {-3, 3}, 
  RegionFunction -> Function[{x, y, z, θ, ϕ, r}, denom[θ, ϕ] > 0]
]

Mathematica graphics

Well, back to the drawing board.

What does seem to work is to put some arbitrary large value in by hand wherever the function would be imaginary or infinite:

SphericalPlot3D[If[denom[θ, ϕ] > 0, func[θ, ϕ], 1000], 
  {θ, 0, π}, {ϕ, 0, 2 π}, 
  MaxRecursion -> 7, PlotRange -> {-10, 10}
]

Mathematica graphics

This seems to be a general fix for the SphericalPlot3D case, although we have to increase the MaxRecursion to get rid of ragged edges on the surface.

$\endgroup$
1
  • $\begingroup$ Great answer, though I still have some questions. See update to original post. $\endgroup$
    – David
    Jun 9, 2015 at 17:18
3
$\begingroup$

This seems to fix part of the problem:

SphericalPlot3D[{ -Sqrt[
    1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)], 
  Sqrt[1/(Sin[θ]^2 Cos[2 ϕ] - Cos[θ]^2)]},
 {θ, π/4, 3 π/4}, {ϕ, π/4, -π/4},
 MaxRecursion -> 4]

enter image description here

$\endgroup$

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.