15
$\begingroup$

I tried driving up PlotPoints and MaxRecursion but the intersections look weird, is there some other trick I can do?

plot = Plot3D @@ {Abs[Sqrt[x] + Sqrt[y]] /. {x -> Sin[2 x], 
     y -> Cos[2 y]}, {x, -2, 2}, {y, -2, 2}, 
   PlotPoints -> 200, MeshFunctions -> {#3 &}, Mesh -> 15, 
   MaxRecursion -> 6, Ticks -> None}

enter image description here

$\endgroup$
  • $\begingroup$ This looks fine to me, and I wonder what other plotting software would give a better image. If you're using it in a paper, just render it large and scale down for the publication. $\endgroup$ – David G. Stork Dec 11 '17 at 18:17
  • $\begingroup$ I tried a slightly different ViewPoint and the ridges disappeared. $\endgroup$ – David G. Stork Dec 11 '17 at 18:24
  • 1
    $\begingroup$ related: 3D graphics rendering artifact with overlapping planes (z-fighting) $\endgroup$ – kglr Dec 11 '17 at 18:43
  • 1
    $\begingroup$ NormalsFunction -> None removes the glitches, and at such a high sampling density, the output looks pretty good. $\endgroup$ – Michael E2 Dec 11 '17 at 21:34
17
$\begingroup$

You can do it using ListPlot3D, and those effect go away

data=Table[ Abs[Sqrt[Sin[2 x]]+Sqrt[Cos[2 y]]],{x,-2,2,.005},{y,-2,2,.005}];
ListPlot3D[data,ImageSize->700,MeshFunctions->{#3&}]

Mathematica graphics

Compare to your plot

Mathematica graphics

It seems to be due to different sampling used by Plot3D vs. the manual method used in ListPlot3D. At least this can be a workaround until a better solution is found.

$\endgroup$
7
$\begingroup$

The funny color the OP points out is the lighting effect that arises from a sharp-corner-like singularities in the surface. The discretization causes some polygons to bridge a sharp corner and reflect the light in a different way than its neighbor polygons. Added: In particular, the recursive subdivision algorithm of Plot3D causes adjacent polygons to have different angles. Nasser's ListPlot approach has the same problem with bridging the corner, but it has a regular and very fine mesh aligned with the singularities: the mesh gives the singularities a regular appearance along their paths. The ListPlot approach also uses almost 50 times the memory than the method below on the OP's example.

It's too bad the *Plot* functions do not have a way of specifying and treating singular points as NIntegrate does. For a plot with a tensor-product-like structure in the OP's post, all it would take is to specify the singular x values and singular y values to have the plot restart at these boundary points.

Here's a way to accomplish something like that by dividing the plot region into subrectangles. Plot3D has a lot of automatic processing, and coordinating the subplots will require some tweaking. For instance, the Mesh is computed based on the PlotRange of each subplot. Therefore you have to manually specify Mesh. (One could make this automatic by computing the plot twice, once to determine the mesh range and specs, and again with the proper mesh specification.)

ClearAll[plot3D];
SetAttributes[plot3D, HoldAll];
plot3D[f_, {x_, x0__}, {y_, y0__}, opts : OptionsPattern[Plot3D]] :=
 Show[
  Plot3D[f, {x, #[[1, 1]], #[[1, 2]]}, {y, #[[2, 1]], #[[2, 2]]}, opts] & /@
   Flatten[  (* Partition into rectangles *)
    Outer[List,
     Partition[SortBy[{x0}, N], 2, 1], 
     Partition[SortBy[{y0}, N], 2, 1],
     1],
    1],
  PlotRange -> (OptionValue[PlotRange] /. Automatic -> All)
  ]

(* compute the singular values of x and y *)
sing = With[{s = 
    Simplify`FunctionSingularities[
     Abs[Sqrt[x] + Sqrt[y]] /. {x -> Sin[2 x], y -> Cos[2 y]},
     {x, y}, {"ALL"}]},
  Merge[
   Cases[Flatten[
     Quiet@Simplify[
       Solve[# && -2 < x < 2 && -2 < y < 2, {x, y}, Reals] & /@ 
        Or @@@ Apply[And, s, {2}], -2 < x < 2 && -2 < y < 2]],
    sol : Verbatim[Rule][x | y, _] :> <|sol|>],
   Join]
  ]
(*  <|x -> {0, -(π/2), π/2}, y -> {-(π/4), π/4}|>  *)

(* plot the OP's graph *)
plot3D @@ {Abs[Sqrt[x] + Sqrt[y]] /. {x -> Sin[2 x], y -> Cos[2 y]}, 
  Flatten@{x, -2, sing[x], 2}, Flatten@{y, -2, sing[y], 2}, 
  MeshFunctions -> {#3 &}, Mesh -> {Subdivide[0., 2., 15 + 1]}, 
  Ticks -> Automatic, PlotRange -> All}

Mathematica graphics

$\endgroup$
  • $\begingroup$ With some work, this could probably be extended to curved singularities, provided it was computationally feasible. $\endgroup$ – Michael E2 Dec 11 '17 at 21:23
4
$\begingroup$

Increase the MaxRecursion and use the WorkingPrecision option

plot = Plot3D @@ {Abs[Sqrt[x] + Sqrt[y]] /. {x -> Sin[2 x], 
     y -> Cos[2 y]}, {x, -2, 2}, {y, -2, 2}, PlotPoints -> 200, 
   MeshFunctions -> {#3 &}, Mesh -> 15, MaxRecursion -> 8, 
   Ticks -> None, WorkingPrecision -> 15, ImageSize -> Large}

enter image description here

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