4
$\begingroup$

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.

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

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!

$\endgroup$
  • $\begingroup$ 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. $\endgroup$ – Jason B. Feb 11 '16 at 12:57
  • $\begingroup$ @Jason B You are right. I will edit the answer. $\endgroup$ – Alexei Boulbitch Feb 11 '16 at 13:29
  • $\begingroup$ You could even make it a function of x, y, and z so that it works for any values.. $\endgroup$ – Jason B. Feb 11 '16 at 13:30
  • $\begingroup$ @Jason B Of course, I was simply lazy today. $\endgroup$ – Alexei Boulbitch Feb 11 '16 at 13:33
6
$\begingroup$

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.

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

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[ϕ])]}.

$\endgroup$
3
$\begingroup$
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
$\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.