5
$\begingroup$

The code below generates a plot with some ugly "fringes". Is there a way to get rid of them and get a smoother graphic?

a = 2.3;
myGray = Function[{x, y, z}, GrayLevel[1]];
s1 = ParametricPlot3D[{0, a, 0} + {x, Sqrt[1 - x^2 - y^2], y}, {x, y} \[Element] Disk[{0, 0}, 1], Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, PlotPoints -> 100];
s2 = ParametricPlot3D[{0, -a, 0} + {x, -Sqrt[1 - x^2 - y^2], y}, {x, y} \[Element] Disk[{0, 0}, 1], Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, PlotPoints -> 100];
s3 = ParametricPlot3D[{0, 0, 0.8 a} + {x, y, Sqrt[1 - x^2 - y^2]}, {x, y} \[Element] Disk[{0, 0}, 1], Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, PlotPoints -> 100];
s4 = ParametricPlot3D[{0, 0, -0.8 a} + {x, y, -Sqrt[1 - x^2 - y^2]}, {x, y} \[Element] Disk[{0, 0}, 1], Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, PlotPoints -> 100];
s5 = ParametricPlot3D[{a, 0, 0} + {Sqrt[1 - x^2 - y^2], x, y}, {x, y} \[Element] Disk[{0, 0}, 1], Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, PlotPoints -> 100];
s6 = ParametricPlot3D[{-a, 0, 0} + {-Sqrt[1 - x^2 - y^2], x, y}, {x, y} \[Element] Disk[{0, 0}, 1], Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, PlotPoints -> 100];
Show[s1, s2, s3, s4, s5, s6, PlotRange -> All, Boxed -> False, Lighting -> "Neutral", ViewPoint -> {-2.1, -2.4, 1.1}, ViewVertical -> {0, 0, 1}]
$\endgroup$
3
$\begingroup$

You can restrict x and y to Disk[] using RegionFunction:

s1 = ParametricPlot3D[{0, a, 0} + {x, Sqrt[1 - x^2 - y^2], y}, 
  {x, -Pi, Pi}, {y, -Pi, Pi}, 
  RegionFunction -> (#3^2 + #4^2 <= 1 &), Mesh -> 21, 
  Boxed -> False, 
  Axes -> None, 
  ColorFunction -> myGray, 
  PlotPoints -> 100]

enter image description here

Doing the same for s2 thru s6 we get

enter image description here

$\endgroup$
3
$\begingroup$

The fringes stem from the fact that the disk is discretized into a triangle mesh and its boundary edges are not very short (and the fact that $\sqrt{1 - r^2}$ is not differentiable at the point $r =1$). You can avoid this, e.g., by using a different parameterization:

s1 = ParametricPlot3D[{0, a, 0} + {r Cos[t], Sqrt[1 - r^2], r Sin[t]},
  {r, 0, 1}, {t, -Pi, Pi},
  Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, 
  PlotPoints -> 100
  ]
$\endgroup$
  • 1
    $\begingroup$ Or usual parametrization of hemisphere: ParametricPlot3D[{0, a, 0} + {Sin[f] Cos[t], Cos[f], Sin[f] Sin[t]}, {f,0,Pi/2}, {t,-Pi,Pi}, Mesh -> 21, Boxed -> False, Axes -> None, ColorFunction -> myGray, PlotPoints -> 100] $\endgroup$ – Alx Jul 20 at 1:41
  • 1
    $\begingroup$ Thanks, but the point is to show this specific parametrization; it's for a textbook. $\endgroup$ – Frunobulax Jul 20 at 8:34
3
$\begingroup$

ImplicitRegion[] works better than Disk[] (but why?):

ParametricPlot3D[{2.3, 0, 0} + {Sqrt[1 - x^2 - y^2], x, y},
 {x, y} ∈ ImplicitRegion[x^2 + y^2 <= 1, {x, y}], Mesh -> 21, 
 Boxed -> False, Axes -> None, ColorFunction -> (GrayLevel[1] &), 
 PlotPoints -> 100]

enter image description here

Update: Another approach is to control the discretization of the Disk[], the boundary being the most important element in this problem:

disk = BoundaryDiscretizeRegion[Disk[{0, 0}, 1], MaxCellMeasure -> "Length" -> 0.001];
disk = DiscretizeRegion[disk];

ParametricPlot3D[{0, 2.3, 0} + {x, Sqrt[1 - x^2 - y^2], y},
 {x, y} ∈ disk, Mesh -> 21, Boxed -> False, Axes -> None, 
 ColorFunction -> (White &), PlotRange -> All]

enter image description here

$\endgroup$
  • $\begingroup$ Thanks. Unfortunately, I can only accept one of the answers... :( $\endgroup$ – Frunobulax Jul 20 at 14:52
  • 1
    $\begingroup$ @Frunobulax You're welcome, and that's the way it is. I added an alternative method, BTW. $\endgroup$ – Michael E2 Jul 20 at 15:41

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.