Mathematica RegionPlot on the surface of the unit sphere?

问题

I am using RegionPlot3D in Mathematica to visualise some inequalities. As the inequalities are homogeneous in the coordinates they are uniquely determined by their intersection with the unit sphere. This gives some two-dimensional regions on the surface of the sphere which I would like to plot. My question is how?

If requested I would be more than happy to provide some Mathematica code; although I believe that the answer should be independent on the details of the regions I'm trying to plot.

Thanks in advance!

Update: In case anyone is interested, I have recently finished a paper in which I used Sasha's answer below in order to make some plots. The paper is Symmetric M-theory backgrounds and was arXived last week. It contains plots such as this one:

Thanks again!

回答1:

Please look into RegionFunction. You can use your inequalities verbatim in it inside ParametricPlot3D.

Show[{ParametricPlot3D[{Sin[th] Cos[ph], Sin[th] Sin[ph], 
    Cos[th]}, {th, 0, Pi}, {ph, 0, 2 Pi}, 
   RegionFunction -> 
    Function[{x, y, z}, And[x^3 < x y z + z^3, y^2 z < y^3 + x z^2]], 
   PlotRange -> {-1, 1}, PlotStyle -> Red], 
  Graphics3D[{Opacity[0.2], Sphere[]}]}]

回答2:

Here's the simplest idea I could come up with (thanks to belisarius for some of the code).

Project the inequalities onto the sphere using spherical coordinates (with θ=q, φ=f).
Plot these as a flat region plot.
Then plot this as a texture the sphere.

Here's a couple of homogeneous inequalities of order 3

ineq = {x^3 < x y^2, y^2 z > x z^2};

coords = {x -> r Sin[q] Cos[f], y -> r Sin[q] Sin[f], z -> r Cos[q]}/.r -> 1

region = RegionPlot[ineq /. coords, {q, 0, Pi}, {f, 0, 2 Pi}, 
  Frame -> None, ImagePadding -> 0, PlotRangePadding -> 0, ImageMargins -> 0]

ParametricPlot3D[coords[[All, 2]], {q, 0, Pi}, {f, 0, 2 Pi}, 
 Mesh -> None, TextureCoordinateFunction -> ({#4, 1 - #5} &), 
 PlotStyle -> Texture[Show[region, ImageSize -> 1000]]]

回答3:

Simon beat me to the punch but here's a similar idea, based on lower level graphics. I deal with linear, homogeneous inequalities of the form Ax>0.

A = RandomReal[{0, 1}, {8, 3}];
eqs = And @@ Thread[
    A.{Sin[phi] Cos[th], Sin[phi] Sin[th], Cos[phi]} >
        Table[0, {Length[A]}]];
twoDPic = RegionPlot[eqs,
    {phi, 0, Pi}, {th, 0, 2 Pi}];
pts2D = twoDPic[[1, 1]];
spherePt[{phi_, th_}] := {Sin[phi] Cos[th], Sin[phi] Sin[th], 
    Cos[phi]};
rpSphere = Graphics3D[GraphicsComplex[spherePt /@ pts2D,
   twoDPic[[1, 2]]]]

Let's compare it against a RegionPlot3D.

rp3D = RegionPlot3D[And @@ Thread[A.{x, y, z} >
      Table[0, {Length[A]}]],
 {x, -2, 2}, {y, -2, 2}, {z, -2, 2},
   PlotStyle -> Opacity[0.2]];
Show[{rp3D, rpSphere}, PlotRange -> 1.4]

回答4:

SphericalPlot3D[0.6, {\[Phi], 0, \[Pi]}, {\[Theta], 0, 2 \[Pi]}, 
 RegionFunction -> 
  Function[{x, y, z}, 
   PolyhedronData["Cube", "RegionFunction"][x, y, z]], Mesh -> False, 
 PlotStyle -> {Orange, Opacity[0.9]}]

来源：https://stackoverflow.com/questions/5788842/mathematica-regionplot-on-the-surface-of-the-unit-sphere

标签

wolfram-mathematica

plot