Mathematica RegionPlot on the surface of the unit sphere?

12
votes

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:

F-moduli space for a symmetric M-theory background

Thanks again!

4
wolfram-mathematicaplot
Hi José. Welcome to stackoverflow, it's nice to see you over here (and thanks for all of the nice physics notes). - Simon
Many thanks, Simon! I'm impressed by the speed this question was answered. It's almost as fast as in MathOverflow :) - José Figueroa-O'Farrill
@Jose Welcome to stackoverflow. Please remember to accept one of the answers that solved your problem. The faq has some useful information. - Sasha
Dear Sasha, Thanks. I am quite familiar with the software from my involvement in MathOverflow. I tend to wait a little to accept an answer to ensure I accept the best one. I have just been playing with the different answers and I like yours the best, hence I've accepted that. Cheers, José - José Figueroa-O'Farrill
@José: Only almost as fast... I guess we'll have to try harder! My excuses are that the Mathematica community here is still quite small and that I was watching West Wing whilst writing my solution (Otherwise I might have had the clarity of mind to remember RegionFunction). - Simon

4 Answers

13
votes

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[]}]}]

enter image description here

12
votes

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]

flat region

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

animation

5
votes

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]
2
votes
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]}]