10
$\begingroup$

I looked but haven't found an answer to this one: I'd like to create a region that represents a sector of a ball, bounded between radii $r_1$ and $r_2$, polar angles $\theta_1$ and $\theta_2$, and azimuthal angles $\varphi_1$ and $\varphi_2$. There seems to be no built-in functionality to achieve this directly. Do I have to assemble the region from parametric surfaces representing the spherical parts of the boundary, and trapezoids for the plane parts?

$\endgroup$
14
$\begingroup$
sphericalSegment[{r1_, r2_}, {θ1_, θ2_}, {ϕ1_, ϕ2_}] := 
 Module[{plot, pts, surf, bdy},
  plot = ParametricPlot3D[{Cos[θ] Sin[ϕ], Sin[θ] Sin[ϕ], Cos[ϕ]},
    {θ, θ1, θ2}, {ϕ, ϕ1, ϕ2}, 
    Mesh -> None, BoundaryStyle -> Black];
  pts = First@Cases[plot, GraphicsComplex[p_, ___] :> p, Infinity];
  surf = First@Cases[plot, Polygon[p_] :> p, Infinity];
  bdy = First@Cases[plot, Line[p_] :> p, Infinity];
  GraphicsComplex[
   Join[r1*pts, r2*pts],
   {EdgeForm[],
    Polygon[surf], Polygon[Reverse /@ surf + Length@pts],
    Polygon[Join[#, Reverse@# + Length@pts], 
       VertexNormals -> Cross[Subtract @@ pts[[#]], pts[[First@#]]]] & /@ 
     Partition[bdy, 2, 1, 1]},
   VertexNormals -> Join[-pts, pts]
   ]
  ]

Graphics3D[
 sphericalSegment[{0.95, 1.1}, {0, Pi/3}, {Pi/6, Pi/2}]
 ]

Mathematica graphics

$\endgroup$
  • $\begingroup$ Awesome solution, thanks! $\endgroup$ – Pirx Sep 11 '16 at 4:26
  • $\begingroup$ +1, but how did you know that you had to write Reverse /@ surf rather than just surf? $\endgroup$ – C. E. Sep 11 '16 at 10:54
  • 1
    $\begingroup$ @C.E. (1) I've done it many times, so I do it without thinking. Sometimes I wonder if it's always necessary, but I do it anyway. (2) Polygons have an orientation (e.g. used by FaceForm[]). Reversing the points reverses the orientation. Note the VertexNormals are reversed, too (negatives of each other). I think if r1 > r2, you'll still get a good-looking segment, but with the notions of inside/outside reversed. $\endgroup$ – Michael E2 Sep 11 '16 at 13:08
  • $\begingroup$ ok, good to know. Thanks. $\endgroup$ – C. E. Sep 11 '16 at 21:20
5
$\begingroup$

Definition of the region:

reg := (r1^2 <= x^2 + y^2 + z^2 <= r2^2 && (* conditions on radius *)
        θ1 <= ArcTan[z, Sqrt[x^2 + y^2]] <=  θ2 && (* conditions on polar angle *)
        φ1 <= ArcTan[x, y] <= φ2 (* conditions on azimuthal angle *)
        );

Definition of the parameters:

{r1, r2, θ1, θ2, φ1, φ2} = {2, 2.2, 30°, 180°, 15°, 85°};

Plots:

RegionPlot3D[ImplicitRegion[reg, {x, y, z}],
             PlotPoints -> 80, Boxed -> False, ViewAngle -> 20°]

spherical sector

RegionPlot3D[reg, {x, -2.5, 2.5}, {y, -2.5, 2.5}, {z, -2.5, 2.5}, Axes -> False, 
             PlotPoints -> 80, Boxed -> False, ViewAngle -> 20°, Mesh -> None]

spherical sector

$\endgroup$
  • $\begingroup$ Much more compact code, but RegionPlot is often somewhat "rough around the edges". I think there's a trick to get this to look better by going through DiscretizedRegion somehow. Too tired to look it up now, but that might work. Overall your code above is quite elegant, thanks! $\endgroup$ – Pirx Sep 11 '16 at 4:29
  • 2
    $\begingroup$ @Pirx, you might want to see this. $\endgroup$ – J. M. is away Dec 11 '16 at 3:12
  • $\begingroup$ Ahah, very nice. Thanks! $\endgroup$ – Pirx Dec 11 '16 at 4:11
3
$\begingroup$

The NURBS representation of a spherical sector is particularly convenient, and has the advantage of not having to carry too many Polygon[] objects:

sphericalSegment[{r1_, r2_}, {θ1_, θ2_}, {φ1_, φ2_}] /; r1 < r2 :=
         Module[{cknots = {0, 0, 0, 1, 1, 1}, lknots = {0, 0, 1, 1},
                 θa = θ2 - θ1, φa = φ2 - φ1, a1, a2, cp, cθ, cφ, p1, p2, ws, wθ, wφ},
                cθ = Cos[θa/2]; cφ = Cos[φa/2];
                a1 = {Cos[θ1], Sin[θ1]}; a2 = {Cos[θ2], Sin[θ2]};
                p1 = {Sin[φ1] , Cos[φ1]}; p2 = {Sin[φ2], Cos[φ2]};
                cp = Map[Function[pt, Append[#1 pt, #2]],
                         {a1, Normalize[(a1 + a2)/2]/cθ, a2}] & @@@
                     {p1, Normalize[(p1 + p2)/2]/cφ, p2};
                ws = Outer[Times, {1, cφ, 1}, {1, cθ, 1}];
                wθ = Outer[Times, {1, 1}, {1, cθ, 1}];
                wφ = Outer[Times, {1, 1}, {1, cφ, 1}];
                {BSplineSurface[r1 Reverse[cp, 2], SplineDegree -> 2,
                                SplineKnots -> {cknots, cknots}, SplineWeights -> ws],
                 BSplineSurface[Outer[Times, {r1, r2}, cp[[1]], 1], SplineDegree -> {1, 2},
                                SplineKnots -> {lknots, cknots}, SplineWeights -> wθ],
                 BSplineSurface[Outer[Times, {r1, r2}, Reverse[cp[[All, 1]]], 1],
                                SplineDegree -> {1, 2}, SplineKnots -> {lknots, cknots},
                                SplineWeights -> wφ], 
                 BSplineSurface[Outer[Times, {r1, r2}, cp[[All, -1]], 1],
                                SplineDegree -> {1, 2}, SplineKnots -> {lknots, cknots},
                                SplineWeights -> wφ],
                 BSplineSurface[Outer[Times, {r1, r2}, Reverse[cp[[-1]]], 1],
                                SplineDegree -> {1, 2}, SplineKnots -> {lknots, cknots},
                                SplineWeights -> wθ],
                 BSplineSurface[r2 cp, SplineDegree -> 2,
                                SplineKnots -> {cknots, cknots}, SplineWeights -> ws]}]

Some examples:

Graphics3D[{EdgeForm[], sphericalSegment[{9/10, 1}, {0, π/3}, {π/6, π/2}]}]

a spherical segment

Graphics3D[{EdgeForm[], sphericalSegment[{9/10, 1}, {π/3, 3 π/4}, {π/2, π}]}]

another spherical segment

$\endgroup$
  • $\begingroup$ P. S. If needed, one can add BaseStyle -> {BSplineSurface3DBoxOptions -> {Method -> {"SplinePoints" -> 40}}}, similar to what was done here. $\endgroup$ – J. M. is away Dec 11 '16 at 3:24
  • $\begingroup$ Can this be used to generate arbitrary spherical polygon for given vertices? (I just don't have time to investigate :)) If you want I will ask an official question. $\endgroup$ – Kuba Apr 19 '17 at 20:31
  • $\begingroup$ @Kuba, no, this is only good for making spherical quadrilaterals, or isosceles spherical triangles. Making an arbitrary spherical polygon with NURBS looks tough, from what I've researched. $\endgroup$ – J. M. is away Apr 20 '17 at 0:58
  • $\begingroup$ Thanks. That's a pity. Does the fact that I don't care about very precise approximation changes anything? $\endgroup$ – Kuba Apr 20 '17 at 13:54
  • $\begingroup$ @Kuba, you might want to look at this thread in the meantime; someday, when I find time, I'll try implementing the NURBS method for spherical polygons. $\endgroup$ – J. M. is away Apr 20 '17 at 13:59

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.