20
$\begingroup$

I apologize for the text description, but new users are not allowed to post images.

I want to draw a circle that cuts through the center of a sphere and has an inclination of 15 degrees with the horizontal axes (equator). Actually, there are infinite number of great circles that can satisfy this requirement. If someone can show me how to make a Manipulation, that will be better.

$\endgroup$
3
  • $\begingroup$ What parameter would like to see varied in the Manipulate? The angle of inclination? The equatorial nodal points? $\endgroup$
    – m_goldberg
    Dec 16, 2012 at 12:32
  • $\begingroup$ the equatorial nodal points thanks $\endgroup$
    – Tesseract
    Dec 16, 2012 at 12:40
  • 2
    $\begingroup$ There are any number of demos on the Wolfram Demonstrations site that might help. You can search explicitly for "Great Circle": demonstrations.wolfram.com/search.html?query=great%20circle $\endgroup$ Dec 16, 2012 at 13:16

5 Answers 5

23
$\begingroup$

The idea is quite simple: Since any great circle can be parametrized as $\cos(\theta)u + \sin(\theta)v$ where $u$ and $v$ are two orthonormal vectors. One can start with $u=\{1,0,0\}, v=\{0,1,0\}$ and use RotationTransform to get out of the xy plane, then use RotationTransform again to spin around the z-axis to get all great circles with desired inclination.

Manipulate[
 (* Rotation deg° out of the xy plane *)
 rx = RotationTransform[deg Degree, {0, 1, 0}];

 (* Spin around z axis *)
 rz = RotationTransform[ϕ Degree, {0, 0, 1}];
 {u, v} = rz @ rx @ {{1, 0, 0}, {0, 1, 0}};

 Show[{
   Graphics3D[{ 
     {Opacity[0.4], Sphere[]},
     {Opacity[0.5], 
      Polygon[{ {-1, -1, 0}, {1, -1, 0}, {1, 1, 0}, {-1, 1, 0}}]},
     {Arrow[{{0, 0, 0}, u}],
      Arrow[{{0, 0, 0}, v}]}
     }],
   ParametricPlot3D[{
     Cos[θ] u + Sin[θ] v, (* The great circle in question *)
     {Cos[θ], Sin[θ], 0}, (* Normal unit circle *) 
     RotationTransform[θ, {0, 0, 1}] /@ {u, -u} (* The red dashed stuff *)
     }, {θ, -Pi, Pi},
    PlotStyle -> {Directive[Blue, Thick], Black, Directive[Red, Dashed]}]
   },
  Axes -> True,
  AxesLabel -> {"x", "y", "z"}],
 {{deg, 15, "Inclination"}, -180, 180},
 {ϕ, 0, 360}]

Output

$\endgroup$
17
$\begingroup$

Here is a static solution to the problem. It shows a mesh on the sphere that represents the normal lat-long coordinate system.

A function representing the equator.

equator[θ_] := {Cos[θ], Sin[θ], 0}

A function and a plot representing the inclined circle. Note that the inclination is accomplished by a rotation of the equator about the x-axis.

inclinedCircle[θ_, i_] := 
   RotationTransform[i, {1, 0, 0}][equator[θ]];
circlePlot[i_] := 
    ParametricPlot3D[
       Evaluate[inclinedCircle[θ, i °]], {θ, 0, 2 π},
       PlotStyle -> {Thickness[0.005]}]  

A function and a plot representing the sphere.

sphere[u_, v_] :=
   {Cos[u] Cos[v], Sin[u] Cos[v], Sin[v]};
spherePlot = 
   ParametricPlot3D[
      Evaluate[sphere[u, v]], {u, 0, 2 π}, {v, -π, π}];

A great circle inclined at 60°.

Show[{spherePlot, circlePlot[60]},
   Axes -> False, Boxed -> False, 
   PlotRange -> All, SphericalRegion -> True,
   ViewPoint -> {5, 0, 0}, 
   ViewAngle -> 12 °]

enter image description here

Update 1

With a little modification to inclinedCircle and circlePlot to handle nodal point shift, it is easy to construct an interactive version. A rotation about the z-axis has been added to accomplish the nodal shift.

inclinedCircle[θ_, i_, offset_] := 
   RotationTransform[offset, {0, 0, 1}]
      [RotationTransform[i, {1, 0, 0}][equator[θ]]];
circlePlot[i_, offset_: 0] := 
    ParametricPlot3D[
       Evaluate[inclinedCircle[θ, i °, offset °]], {θ, 0, 2 π},
       PlotStyle -> {Thickness[0.005]}]  

The parameter ι is the inclination and the parameter α is the equatorial ascending node.

Manipulate[
   Show[{spherePlot, circlePlot[ι, α]},
      Axes -> False, 
      Boxed -> False,
      PlotRange -> All,
      SphericalRegion -> True, 
      ViewPoint -> {5, 0, 0},
      ViewAngle -> 12 °],
   {{ι, 60.}, 0., 90., 5., Appearance -> "Labeled"},
   {{α, 0.}, 0., 355., 5., Appearance -> "Labeled"},
   SaveDefinitions -> True]

enter image description here

Update 2

Rather than describing a great circle as the composition of rotations applied to the equator, those rotations can be used to derive a more conventional description, a parametic function built from elementary trigonometric functions. To do this, first apply inclinedCircle to some value-free symbols.

Clear[θ, ι, φ]; inclinedCircle[θ, ι, φ]

{Cos[θ] Cos[φ] - Cos[ι] Sin[θ] Sin[φ], Cos[ι] Cos[φ] Sin[θ] + Cos[θ] Sin[φ], Sin[θ] Sin[ι]}

From the output expression, write a function generator, inclinedCircle, that when given the inclination ι and the ascending node φ, returns a pure function producing the points on the desired great circle.

inclinedCircleF[ι_, φ_] = 
   {Cos[#] Cos[φ] - Cos[ι] Sin[#] Sin[φ], 
    Cos[ι] Cos[φ] Sin[#] + Cos[#] Sin[φ],
    Sin[#] Sin[ι]}&;

Next write a plotting function that will use the function generator rather than the rotations.

circlePlot2[ι_, φ_: 0.] := 
   ParametricPlot3D[
      inclinedCircleF[ι °, φ °][θ], {θ, 0., 2. π},
      PlotStyle -> {Thickness[0.005]}]

Finally, substitute the new plotting function for the original one in the Manipulate.

Manipulate[
  Show[{spherePlot, circlePlot2[ι, φ]},
     Axes -> False, 
     Boxed -> False, 
     PlotRange -> All, 
     SphericalRegion -> True, 
     ViewPoint -> {5, 0, 0}, 
     ViewAngle -> 12 °],
  {{ι, 60.}, 0., 90., 5., Appearance -> "Labeled"},
  {{φ, 0.}, 0., 355., 5., Appearance -> "Labeled"},
  SaveDefinitions -> True]

The output from evaluating this Manipulate expression is exactly the same as with the one using rotations, so I won't repeat it here.

$\endgroup$
15
$\begingroup$

Great answers have already appeared. In the spirit of demonstrating multiple solutions to a problem with Mathematica, I would like to offer one using a different approach.

First, some geometric analysis. This great circle bounds a hemisphere lying in a half-space determined by a normal direction to the circle's plane. Letting $\theta$ be the latitude at which the circle crosses the equator, we find that $(\cos(\theta), \sin(\theta), 0)$ is a direction on the circle. The perpendicular direction $(-\sin(\theta), \cos(\theta), 0)$ has to be elevated by an angle $\alpha$, whence it equals $(-\cos(\alpha) \sin(\theta), \cos(\alpha)\cos(\theta), \sin(\alpha))$. The cross-product of these vectors is the desired normal direction.

One expedient--and straightforward--solution uses Contour3D to depict the surface of the sphere as the contour $x^2+y^2+z^2=1$ and exploits its RegionFunction option to limit that contour to the desired hemisphere.

For reference I use a world globe taken directly from the help page for Texture. It requires an image of the world's surface, such as

im = Import["http://www.ngdc.noaa.gov/mgg/topo/pictures/GLOBALeb6colshadesmall.jpg"];

This is plastered onto a slightly shrunken parametric plot of a sphere (or ellipsoid, if you want greater realism), stripped of all detail except this texture:

globe = ParametricPlot3D[0.99 {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]},
    {u, 0, 2 π}, {v, 0, π}, 
    Mesh -> None, TextureCoordinateFunction -> ({#4, 1 - #5} &), 
    PlotStyle -> Directive[Specularity[White, 20], Texture[im]], 
    Lighting -> "Neutral", Axes -> False, RotationAction -> "Clip"];

Over that we may drape the hemisphere semi-transparently.

Image

The code allows dynamic manipulation of the elevation and orientation ("azimuth") of the great circle.

Manipulate[
 Block[{normal = 
    Cross[{Cos[θ], Sin[θ], 0}, 
          {Cos[α] (-Sin[θ]), Cos[α] Cos[θ], Sin[α]}]},
  Show[globe, 
   ContourPlot3D[x^2 + y^2 + z^2, {x, -1, 1}, {y, -1, 1}, {z, -1, 1}, 
    Contours -> {1}, ContourStyle -> Opacity[0.5], Mesh -> None, 
    RegionFunction -> Function[{x, y, z}, normal . {x, y, z} ≥ 0]], 
   Boxed -> False]],
 {{α, 0, "Elevation"}, -π/2, π/2}, {{θ, 0, "Azimuth"}, -π, π}
 ]

Include additional 3D graphics as you will to indicate the normal direction, the Equatorial Plane, a latitude-longitude graticule, etc.

$\endgroup$
14
$\begingroup$

As noted in this thread, it's often more convenient to manipulate B-splines instead of lines.

Thus, using the B-spline representation derived by Piegl and Tiller in this article, we have the following routine:

greatCircle[φ_, θ_, r_: 1] := BSplineCurve[
  Composition[RotationTransform[θ, {0, 0, 1}], RotationTransform[-φ, {0, 1, 0}]] /@
  (r {{1, 0, 0}, {1, 1, 0}, {-1, 1, 0}, {-1, 0, 0}, {-1, -1, 0}, {1, -1, 0}, {1, 0, 0}}),
  SplineDegree -> 2, SplineKnots -> {0, 0, 0, 1/4, 1/2, 1/2, 3/4, 1, 1, 1},
  SplineWeights -> {1, 1/2, 1/2, 1, 1/2, 1/2, 1}]

Try it out:

With[{ε = 1*^-3 (* shrinks sphere slightly *), φ = 30° (* inclination *)}, 
     Graphics3D[{{Opacity[2/5, Blue], Sphere[{0, 0, 0}, 1 - ε]},
                 {Directive[AbsoluteThickness[3], Red], greatCircle[φ, 0]}},
                Lighting -> "Neutral"]]

sphere and great circle

Spin things around a bit:

With[{ε = 10^-3, φ = 30°}, 
     Animate[Graphics3D[{{Opacity[2/5, Blue], Sphere[{0, 0, 0}, 1 - ε]},
                         {Directive[AbsoluteThickness[3], Red], greatCircle[φ, θ]}},
                        Lighting -> "Neutral", SphericalRegion -> True],
             {θ, 0, 360°, 15°}]]

rotating sphere and great circle

Adding the fancy stuff (e.g. arrows and planes) is left to you as an exercise.

$\endgroup$
0
12
$\begingroup$

Just use MeshFunction.

Manipulate[ParametricPlot3D[{Sin[\[Theta]] Cos[\[Phi]], Sin[\[Theta]] Sin[\[Phi]], Cos[\[Theta]]}, {\[Theta], 0, \[Pi]}, {\[Phi], 0, 2 \[Pi]}, PlotStyle -> Opacity[0.5], Mesh -> {{0.}}, MeshStyle -> {Red, Thick}, MeshFunctions -> {Sin[a] Cos[b] #1 + Sin[a] Sin[b] #2 + Cos[a] #3 &}], {a, 0, \[Pi]}, {b, 0, 2 \[Pi]}]

enter image description here

Let me explain my code.

Since the great circle is the intersection of the sphere and a plane passing through the origin. So all you have to do is to

  1. Find or define the normal vector of the plane. In my case, $(\sin{a}\cos{b},\sin{a}\sin{b},\cos{a})$
  2. Translate the mathematical plane equation into MeshFunction, i.e. Sin[a]Cos[b]#1+Sin[a]Sin[b]#2+Cos[a]#3 &

Mathematica will do the rest. Enjoy:)

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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