10
$\begingroup$

In general how can we create a figure like this?

surface of $\frac{2x^2 y}{x^4+y^2}$

$\endgroup$
12
$\begingroup$

Unfortunately, I don't know how to completely fix that plotting artifact at "z" axis.

z = (2 x^2 y)/(x^4 + y^2);

Plot3D[z, {x, 0, 1}, {y, 0, 1},
 PerformanceGoal -> "Quality",
 PlotPoints -> 100,
 MaxRecursion -> 4,
 Boxed -> False,
 AxesLabel -> {"x", "y", "z"},
 AspectRatio -> 1,
 Ticks -> None,
 AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}},
 AxesStyle -> Thick,
 LabelStyle -> 16,
 PlotRange -> {{0, 1.2}, {0, 1.2}, {0, 1.2}},
 ViewPoint -> 10 {0.5, 1, 0.25},
 MeshFunctions -> {Norm[{#1, #2}] &, #3 &},
 Epilog -> Inset[Style[HoldForm[z] == z, 16], {Right, Top}, {Right, Top}],
 ImageSize -> 400
 ]

plot3D

$\endgroup$
  • $\begingroup$ Can you please explain how " MeshFunctions -> {Norm[{#1, #2}] &, #3 &}" works? What does that mean? $\endgroup$ – David R May 5 '17 at 19:59
  • $\begingroup$ It means we have two sets of mesh divisions. Norm[{#1, #2}] & means a line at equal distance from the origin (could be also written as Sqrt[#1^2 + #2^2] &) and looking along the "z" axis you can see it creates circles. Other set defined by #3 & means mesh lines at equal "z" coordinate. Numbered slots #1, #2, and #3 correspond to "x", "y" and "z" coordinate (in Plot3D). $\endgroup$ – Pinti May 8 '17 at 7:44
11
$\begingroup$

Update: Better mesh grid

This code, while using the parametrization in my original answer that removes the glitch at the z-axis, better reproduces the mesh in the OP's figure. One problem all the other solutions (so far) suffer from is that the linear elements (mesh lines) and surfaces elements do not interact well in rendering: You can see mesh lines poke through near the singularity. One way to fix this is to use Tube instead of Line. The undocumented use of MeshStyle does this, but the color is White (see this answer).

MeshStyle -> {{Black, Tube[0.002]}, {Black, Tube[0.005]}, {Black, Tube[0.002]}}

However, BoundaryStyle does not work this way, but it's not really a problem. So either leave it as a Line or post-process as shown below.

Below I show the plot over the unit quarter-disk, with the default PlotPoints. Increase it for a slightly smoother mesh. I also solved for the z-values of the mesh in terms of the parameter t. This makes the mesh naturally smoother than the method above (for the same number of plot points).

With[{x = r Cos[t], y = r^2 Sin[t]}, 
 plot = ParametricPlot3D[{x, y, (2 x^2 y)/(x^4 + y^2)},
   {r, 0, 1}, {t, 0, Pi/2},
   MeshFunctions -> {#5 &, #5 &, Sqrt[#1^2 + #2^2] &}, 
   Mesh -> {
     Flatten@Table[t /. NSolve[(2 x^2 y)/(x^4 + y^2) == z/10 && 0 < t < Pi/2, t], {z, 9}], 
     Flatten[t /. NSolve[(2 x^2 y)/(x^4 + y^2) == 1 && 0 < t < Pi/2, t]],
     9},
   MeshStyle -> {{Black, Tube[0.002]}, {Black, Tube[0.005]}, {Black, Tube[0.002]}},
   Boxed -> False, AxesLabel -> {"x", "y", "z"}, AspectRatio -> 1, 
   Ticks -> None, AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, 
   AxesStyle -> Thick, BoundaryStyle -> Thick, LabelStyle -> 16, 
   PlotRangePadding -> 0.07 {{0, 1}, {0, 1}, {0, 1}}]]

Mathematica graphics

Post-processing can be done with replacement rules like either of these

plot /. {dir___ /; ! FreeQ[{dir}, Thickness[Large]], Line[p_]} :>
  {Black, dir, Tube[p, 0.005]},
plot /. {Line[p_] :> {Black, Tube[p, 0.005]}}  (* less restrictive *)

Original:

This example has been stuck in my mind since I took multivariable calculus. Ten years later, when I first taught multivariable calculus with Mathematica in 1992, I worked out this parametrization to get around the difficulties of meshing the surface near the singularity at the z-axis. As one can see, the graph approaches the axis:

With[{x = r Cos[t], y = r^2 Sin[t]},
 {x, y, (2 x^2 y)/(x^4 + y^2)} // Simplify]
(*  {r Cos[t], r^2 Sin[t], (16 Cos[t]^2 Sin[t])/(7 + Cos[4 t])}  *)

Here is an updated version taking advantage of the recent ClipPanes. One could also clip via PlotRange. I originally plotted it over {r, 0, 1} without clipping, which plots the surface over the unit disk similar to the above. With this parametrization, the default meshing (PlotPoints/MaxRecursion) is sufficient for a pretty good image, but raising PlotPoints to 25 makes smoother mesh lines.

With[{x = r Cos[t], y = r^2 Sin[t]},
 ParametricPlot3D[{x, y, (2 x^2 y)/(x^4 + y^2)},
  {r, 0, 1.3}, {t, 0, Pi/2},
  PlotPoints -> 25,
  MeshFunctions -> {#3 &, Sqrt[#1^2 + #2^2] &},
  Boxed -> False, AxesLabel -> {"x", "y", "z"}, AspectRatio -> 1, Ticks -> None, 
  AxesEdge -> {{-1, -1}, {-1, -1}, {-1, -1}}, AxesStyle -> Thick, LabelStyle -> 16,
  ClipPlanes -> {{-1, 0, 0, 1}, {0, -1, 0, 1}},
  PlotRange -> {{0, 1}, {0, 1}, {0, 1}},
  PlotRangePadding -> 0.07 {{0, 1}, {0, 1}, {0, 1}}]
 ]

Mathematica graphics

$\endgroup$
5
$\begingroup$

This is just an addendum to Pinti's excellent answer to show how some fairly minor modification of his code can make the plot look more like the OP's figure. I have also removed some unnecessary options.

z[x_, y_] := 2 x^2 y/(x^4 + y^2)

Show[
  Plot3D[z[x, y], {x, 0, 1}, {y, 0, 1},
    PlotPoints -> 100,
    MaxRecursion -> 4,
    Boxed -> False,
    Axes -> False,
    BoxRatios -> {1, 1, .8},
    LabelStyle -> 16,
    PlotRange -> {{0, 1.2}, {0, 1.2}, {0, 1.2}},
    ViewPoint -> 10 {0.5, 1, 0.3}, {* tweaked *)
    MeshFunctions -> {Norm[{#1, #2}] &, #3 &},
    Epilog ->
      Inset[Style["z" == z[x, y], 16], {Right, Top}, {Right, Top}], 
    ImageSize -> 400],
  Graphics3D[
   {Thick, Arrow[{{0, 0, 0}, {1.2, 0, 0}}],
    Arrow[{{0, 0, 0}, {0, 1.2, 0}}],
    Arrow[{{0, 0, 0}, {.075, .075, 1.2}}],
    MapThread[
      Text[Style[#1, "TBI", 16], #2] &, 
      {{x, y, z}, {{1.23, 0, 0}, {0, 1.23, 0}, {.075, .075, 1.24}}}]}]]

plot

Note: I have slanted the z-axis arrow inward a little to close the the small but annoying gap, because to me, a slightly slanted arrow looks better than an accurate one. A purely esthetic decision on my part.

$\endgroup$

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.