3
$\begingroup$

I drew this tapered prolate spheroid in Mathematica as a 3D contour plot:

ContourPlot3D[
  (x^2 + y^2 + z^2)^2 == 1.2 x^3 + 0.36 x 
  (y^2 + z^2), {x, 0, 2}, {y, -1, 1}, {z, -1, 1}]

However, I am quite inexperienced in programming with Mathematica, and I am trying to make it look like this:

enter image description here

At least roughly. Preferably the color scheme, aspect ratio, and general outline could be the same -- the axes would be nice but I understand that this may not be possible.

Here is what I have tried so far:

ContourPlot3D[
  (x^2 + y^2 + z^2)^2 == 1.2 x^3 + 0.36 x (y^2 + z^2), 
  {x, 0, 2}, {y, -1, 1}, {z, -1, 1}, 
  ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][z]], 
  Mesh -> 4,
  Boxed -> False, 
  Axes->False, 
  Lighting->"Neutral", 
  ImageSize->Large]`

Which makes little progress.

Also, slightly unrelated, but when I double click (or click to rotate) on the image produced by the above code, the image becomes quite vivid and clear. How do I save this version of the image, instead of the 'dulled' default?

$\endgroup$
4
$\begingroup$

Here is some analysis that I performed to get a explicit plot rather than an implicit one.

Solve[(x^2 + y^2 + z^2)^2 == 120/100 x^3 + 36/100 x (y^2 + z^2), z, Reals]

This gives

solutions

The 2nd conditional solution is clearly the one giving the top side of the egg-shaped surface you are considering. Therefore, a normal 3D plot of the expression

Sqrt[(1/50) Sqrt[3] Sqrt[27 x^2 + 700 x^3] + (1/50) (9 x - 50 x^2 - 50 y^2)]

should be pursued. It also clear the x-range of plot should be {x, 0, 6/5}. The surface is symmetrical about the x-axis, so the y-range will be {y, -ymax, ymax} and ymax can determined by first evaluating

Reduce[
  0 < x < 6/5 && 
    Sqrt[2] Sqrt[9 x - 50 x^2 + Sqrt[3] Sqrt[x^2 (27 + 700 x)]] - 10 y > 0, 
  y]
0 < x < 6/5 && y < Root[-30 x^3 + 25 x^4 + (-9 x + 50 x^2) #1^2 + 25 #1^4&, 2]

and then

FindMaximum[Root[-30 x^3 + 25 x^4 + (-9 x + 50 x^2) #1^2 + 25 #1^4 &, 2], x]
{0.43456, {x -> 0.649557}}

This suggests that {y, -1/2, 1/2} will work for the y-range.

Using the results of my little analysis, I made the following plot:

Plot3D[
  Sqrt[(1/50) Sqrt[3] Sqrt[27 x^2 + 700 x^3] + (1/50) (9 x - 50 x^2 - 50 y^2)],
  {x, 0, 6/5}, {y, -1/2, 1/2}, 
  ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][z]],
  PlotStyle -> Opacity[.92],
  PlotPoints -> 50,
  BoxRatios -> {1, 1, 1/3},
  Mesh -> None,
  Boxed -> False,
  Axes -> False,
  SphericalRegion -> True,
  Lighting -> "Neutral",
  ImageSize -> 500]

plot

This is certainly closer to the plot you show than the plot your code produces. The question I have is: it is close enough for this post to answer your question?

Update

This update address an issue raised by the OP in a comment to this question.

Here is how to add the lines you ask for. The numbers that determine the end points of the lines come from the analysis given above.

surface =
  Plot3D[
    Sqrt[(1/50) Sqrt[3] Sqrt[27 x^2 + 700 x^3] + (1/50) (9 x - 50 x^2 - 50 y^2)],
    {x, 0, 6/5}, {y, -1/2, 1/2}, 
    ColorFunction -> Function[{x, y, z}, ColorData["Rainbow"][z]],
    PlotStyle -> Opacity[.92],
    PlotPoints -> 50,
    BoxRatios -> {1, 2*0.43456, .43456},
    Mesh -> None,
    Boxed -> False,
    Axes -> False,
    SphericalRegion -> True,
    Lighting -> "Neutral",
    ImageSize -> 500];

lines = 
  Graphics3D[
    {AbsoluteThickness[4], CapForm[None],
     Line[{{0, 0, 0}, {1.2, 0, 0}}], 
     Line[{{.649557, -.43456, 0}, {.649557, .43456, 0}}], 
     Line[{{.649557, 0, 0}, {.649557, .0, .43456}}]}];

Show[surface, lines]

plot

The following views make it evident that the surface is the top half of an egg-shaped surface and not an ellipsoid.

top view

top

front veiw

front

$\endgroup$
  • $\begingroup$ Quite amazing! Thank you immensely! However, I need to show that the major axis is a length of 1.2 and the y axis is (if I recall correctly) 0.84. Is there a way we can add these two lengths as axes? $\endgroup$ – Equinox Feb 24 '18 at 7:05
  • $\begingroup$ @Equinox. My analysis shows that length of the shape along the x-axis is 6/5 = 1.2. It also shows the maximum width perpendicular to x-axis is 2 * .43456 = .86912, not .84. The surface is not ellipsoidal -- it is slightly egg-shaped. It doesn't really have a semi-major axis $\endgroup$ – m_goldberg Feb 24 '18 at 7:25
  • $\begingroup$ Sorry, the length is 1.2 and the perpendicular at the highest point is .43. Is there a way we could show this? $\endgroup$ – Equinox Feb 24 '18 at 7:27
  • $\begingroup$ @Equinox. I have updated my answer to show how the lines can be added. $\endgroup$ – m_goldberg Feb 24 '18 at 7:58
  • $\begingroup$ Yay, perfect. Do you know why a double-click and try-to-move with on the figure changes the image resolution? $\endgroup$ – Equinox Feb 24 '18 at 23:24

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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