Mathematica Stack Exchange is a question and answer site for users of Mathematica. Join them; it only takes a minute:

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

I want to plot the region of a sphere that satisfies the equation

$$ \tan\theta\geq-\frac{rz}{rx\cos\phi + ry\sin\phi} $$

where $rx$, $ry$, $rz$ are known constants. The spherical coordinates $\theta$ and $\phi$ are linked together, making the desired region a smooth cutout of the total sphere.

The basic parametric plot code for a sphere is:

ParametricPlot3D[{Cos[ϕ]*Sin[θ], Sin[ϕ]*Sin[θ], Cos[θ]}, {ϕ, 0, 2 π}, {θ, 0, π}]

I essentially want to apply the above inequality to the limits of this plot, but cannot figure out how to successfully do so. I could just create a table of points in this region and use ListPlot3D or something, but I would prefer a smooth surface.

share|improve this question
4  
Try RegionFunction -> Function[{\[Phi], \[Theta]}, Tan[\[Theta]] >= -z/(x Cos[\[Phi]] + y Sin[\[Phi]])] – Algohi Feb 11 at 3:03
    
That RegionFunction will not work because it includes variables $x$, $y$, and $z$ along with $\theta$ and $\phi$. – David G. Stork Feb 11 at 3:06
    
Actually this works perfectly! x,y,z are known constants. I had just never heard of RegionFunction before. – ahle6481 Feb 11 at 3:07
3  
OP said they are values that are specified. – Algohi Feb 11 at 3:07
up vote 4 down vote accepted

Try also using Boole. As it was commented by Jason B it requires a certain values of the PlotPoints and PlotRange:

ParametricPlot3D[{Cos[ϕ]*Sin[θ], 
   Sin[ϕ]*Sin[θ], Cos[θ]}*
  Boole[Tan[θ] + 1/(Cos[ϕ] + Sin[ϕ]) > 0], {ϕ, 
  0, 2 π}, {θ, 0, π}, PlotPoints -> 100, 
 PlotRange -> Full]

where I put x=y=z=1. It gives this:

enter image description here

Have fun!

share|improve this answer
    
I was also thinking that using Boole was the simplest way to solve this. But you have to increase the PlotPoints and specify the PlotRange. If you add , PlotPoints -> 100, PlotRange -> Full as options it makes the plot perfect. – JasonB Feb 11 at 12:57
    
@Jason B You are right. I will edit the answer. – Alexei Boulbitch Feb 11 at 13:29
    
You could even make it a function of x, y, and z so that it works for any values.. – JasonB Feb 11 at 13:30
    
@Jason B Of course, I was simply lazy today. – Alexei Boulbitch Feb 11 at 13:33

The way I understood the question, the Cartesian parameters are fixed. I'm just going to call them $x_0$, $y_0$ and $z_0$. But since in spherical coordinates we also have $x=r\cos\phi \sin\theta$, $y=r\sin\phi\sin\theta$, $z=r\cos\theta$, we can rewrite the inequality as

$$0 \le x_0 x + y_0 y + z_0 z $$

(the radial coordinate $r$ cancels). This leads me to the following implementation using MeshFunctions:

With[{x0 = -1/2, y0 = 0, z0 = 1/2},
 SphericalPlot3D[1, θ, ϕ, Mesh -> {{0}}, PlotPoints -> 70,
   MeshShading -> {None, Orange},
  MeshStyle -> None,
  MeshFunctions -> {Function[{x, y, z, θ, ϕ, r}, x x0 + y y0 + z z0]}]]

sphere

I used SphericalPlot3D because it's fast. The mesh only has the contour 0 because that's the cutoff for the inequality. The formulation of the problem now uses only Cartesian coordinates, so I need just the corresponding first three arguments of the mesh function.

However, in multiplying the original inequality by trig functions to bring it into the simpler form above, some sign changes are lost. Thanks to theDude for pointing that out. The original inequality can easily be plotted in the same way, though:

With[{x0 = -1/2, y0 = 0, z0 = 1/2}, 
 SphericalPlot3D[1, θ, ϕ, Mesh -> {{0}}, PlotPoints -> 70,
   MeshShading -> {None, Orange}, MeshStyle -> None, 
  MeshFunctions -> {Function[{x, y, z, θ, ϕ, r}, 
     Tan[θ] + z0 /(x0 Cos[ϕ] + y0 Sin[ϕ])]}]]

plot2

The plot agrees with the result of thedude's answer, but this method is faster.

share|improve this answer
    
Your conversion neglects the signs. MeshFunction should be Function[{x, y, z, θ, ϕ, r}, Tan[θ] + z0/(x0 Cos[ϕ] + y0 Sin[ϕ])] – thedude Feb 11 at 7:44
    
@thedude Indeed, I think you're right. I'll change it. – Jens Feb 11 at 8:02

Another approach:

x0 = -1; y0 = 0; z0 = 1;
reg1 = ImplicitRegion[x^2 + y^2 + z^2 == 1, {{x, -1, 1}, {y, -1, 1}, {z, -1, 1}}];
reg2 = ImplicitRegion[
          Reduce[TransformedField["Spherical" -> "Cartesian", 
             Tan[θ] >= -z0/(x0 Cos[ϕ] + y0 Sin[ϕ]), {r, θ, ϕ} -> {x, y, z}] && 
             x ∈ Reals && y ∈ Reals && z ∈ Reals &&
            -1 < x < 1 && -1 < y < 1 && -1 < z < 1, {x, y, z}
          ] // Quiet,
          {x, y, z}
       ];

DiscretizeRegion[RegionIntersection[reg1, reg2], MaxCellMeasure -> 10^-4]

enter image description here


EDIT

Apparently what OP wants is

With[
 {x0 = -1/2, y0 = 0, z0 = 1/2},
 ParametricPlot3D[
  {Cos[ϕ]*Sin[θ], Sin[ϕ]*Sin[θ], 
   Cos[θ]}, {ϕ, 0, 2 π}, {θ, 0, π}, 
  RegionFunction -> 
   Function[{ϕ, θ}, 
    Tan[θ] + z0/(x0 Cos[ϕ] + y0 Sin[ϕ]) >= 0], 
  PlotRange -> All
  ]
 ]

However, I cannot tell why the output doesn't agree with my and Jens's answer. Does anyone have an explanation?


EDIT 2

Jens's plot yields:

enter image description here

if MeshFunctions -> {Function[{x, y, z, θ, ϕ, r}, Tan[θ] + z0 /(x0 Cos[ϕ] + y0 Sin[ϕ])]} is replaced with MeshFunctions -> {Function[{θ, ϕ, r}, Tan[θ] + z0 /(x0 Cos[ϕ] + y0 Sin[ϕ])]}.

share|improve this answer
ParametricPlot3D[
  If[Tan[θ] + -Cos[ϕ]/(
     Cos[θ] Sin[ϕ] Cos[ϕ] + 
      Sin[θ] Sin[ϕ] Sin[ϕ]) > 
    0, {Cos[ϕ] Sin[θ], Sin[ϕ] Sin[θ], 
    Cos[θ]}, Null],
  {ϕ, 0, 2 π}, {θ, 0, π},
  PlotPoints -> 200] // Quiet

enter image description here

or

ParametricPlot3D[{Cos[ϕ] Sin[θ], Sin[ϕ] Sin[θ], Cos[θ]}, {ϕ, 0, 2 π}, {θ, 0, π},
  RegionFunction -> Function[{θ, ϕ}, 
    Tan[θ] + -Cos[ϕ]/(Cos[θ] Sin[ϕ] Cos[ϕ] + Sin[θ] Sin[ϕ] Sin[ϕ]) > 0],
  PlotPoints -> 100] // Quiet
share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.