7
$\begingroup$

How can I map a triangle on a sphere? I want to visualize (plot or animate) it for my student in Non-Euclidean geometry. I have no restrictions on the triangle's kind or on the sphere in $\mathbb R^3$. Thanks for any hint.

$\endgroup$
11
  • 3
    $\begingroup$ Seen this? $\endgroup$ Commented Apr 10, 2013 at 8:44
  • 2
    $\begingroup$ I don't think this question deserves to be closed. No one is required to answer a "code request" question like this. Such as question, apart from a history of similar questions, does not warrant closure. Also, there are several votes on this question for "off topic" yet I believe it has been made clear from the comments and the Accept that this is in fact intended for Mathematica. $\endgroup$
    – Mr.Wizard
    Commented Apr 10, 2013 at 14:18
  • 2
    $\begingroup$ @Mr.Wizard: Thanks for your comment. To be honest, I didn't post a question here to get +1 or -1. I know what to do it via Maple because I made a similar but not animate small program in that area, but to know that in another environment was my willing. :-) $\endgroup$
    – Mikasa
    Commented Apr 10, 2013 at 14:23
  • 2
    $\begingroup$ @Mr.Wizard after the answer, comments etc. the migration to math.se does not make sense (even if I voted to migrate to begin with)... is there a way to undo this? $\endgroup$
    – Yves Klett
    Commented Apr 10, 2013 at 16:53
  • 1
    $\begingroup$ @Babak holy heck-- well, it's back on Mathematica now and I think it's going to stay. Sorry. We just had a kerfuffle reversing the migration and I don't want to start another one. $\endgroup$
    – Mr.Wizard
    Commented Apr 11, 2013 at 13:14

2 Answers 2

10
$\begingroup$

In the comments J. M. linked to a Demonstration by Borut Levart.

Here is code from that, with my own refactoring:

eps = 10^-6;

(* from spherical to cartesian coordinates *)
sp[{ϕ_, θ_}] := {Sin[θ]*Cos[ϕ], Sin[θ]*Sin[ϕ], Cos[θ]}

(* part of great circle between two sphere points *)
ark[{r1_, r2_}, nt_] := Table[
  RotationTransform[t VectorAngle[r1, r2],
    Cross[r1, r2]][r1], {t, 0, 1, 1/nt}]

Manipulate[
 If[p1 == p2, p1 = .99 p2];
 If[p1 == p3, p1 = .99 p3];
 If[p3 == p2, p3 = .98 p2];
 Graphics3D[{
   {Red, Opacity[.6], Sphere[{0, 0, 0}, .995]},
   ark[#, 20] & /@ Subsets[sp /@ {p1, p2, p3}, {2}] // Line,
   PointSize[.015], Point[sp /@ {p1, p2, p3}]
  },
  Boxed -> False,
  ImageSize -> {400, 400},
  FaceGrids -> {{0, 0, -1}},
  FaceGridsStyle -> GrayLevel[.5]
 ],
 {{p1, {4.2, .5}, "point one"}, {eps, π (1 - eps)}, {2 π (1 - eps), eps}},
 {{p2, {.1, 1.1}, "point two"}, {eps, π (1 - eps)}, {2 π (1 - eps), eps}},
 {{p3, {5.1, 1.8}, "point three"}, {eps, π (1 - eps)}, {2 π (1 - eps), eps}},
 ControlPlacement -> Left, SaveDefinitions -> True
]

enter image description here

$\endgroup$
6
  • $\begingroup$ Thanks for the time you took. $\endgroup$
    – Mikasa
    Commented Apr 10, 2013 at 14:25
  • 1
    $\begingroup$ What a code, huh. :D $\endgroup$
    – BoLe
    Commented Apr 11, 2013 at 13:13
  • 1
    $\begingroup$ +1 anyway because of all the fuss with the migration :-) $\endgroup$
    – Yves Klett
    Commented Apr 11, 2013 at 13:23
  • $\begingroup$ As it's a simple transform it's not really appropriate, but do you know CoordinateTransform (further to the deprecated Vector Analysis package) exists as of 9? $\endgroup$ Commented Apr 13, 2013 at 23:19
  • $\begingroup$ @Martin, Wizard here is still on version seven, if memory serves... $\endgroup$ Commented Apr 14, 2013 at 17:58
6
$\begingroup$

I might as well... let me present here the spherical geometry version of this answer. I shall provide two flavors in this answer as well: one where all the arc lengths are given, and one where all the interior angles are given. The formulae used within those routines are nothing more than an application of the spherical law of cosines.

Now, on to the routines. But first, a few auxiliaries:

sphericalDistance[{u1_, v1_}, {u2_, v2_}] :=
                  InverseHaversine[Haversine[v1 - v2] + Sin[v1] Sin[v2] Haversine[u1 - u2]]

GreatCircleArc[p1_, p2_] := Module[{cc, sp1, sp2},
       cc = Cos[sphericalDistance[p1, p2]/2];
       {sp1, sp2} = Append[Sin[#2] Through[{Cos, Sin}[#1]], Cos[#2]] & @@@ {p1, p2};
       BSplineCurve[{sp1, Normalize[(sp1 + sp2)/2]/cc, sp2}, SplineDegree -> 2,
                    SplineKnots -> {0, 0, 0, 1, 1, 1}, SplineWeights -> {1, cc, 1}]]

Here, then, is the routine for drawing a spherical triangle on a unit sphere, given the (normalized) side lengths:

With[{a = π/5, b = π/4, c = π/3},
     Block[{β = N[ArcCos[(Cos[b] - Cos[a] Cos[c])/(Sin[a] Sin[c])]]}, 
      Graphics3D[{{Opacity[1/2], Sphere[]},
                  {Directive[Red, AbsolutePointSize[6]], 
                   Point[{{0, 0, 1}, {Sin[c], 0, Cos[c]},
                          {Sin[a] Cos[β], -Sin[a] Sin[β], Cos[a]}}]},
                  {Directive[Blue, AbsoluteThickness[3]],
                   GreatCircleArc @@@ Partition[{{0, 0}, {0, c}, {-β, a}}, 2, 1, 1]}},
                 PlotRange -> ConstantArray[{-1, 1}, 3]]]]

spherical triangle from arc lengths

Here's the routine for drawing a spherical triangle on the unit sphere, given the interior angles:

With[{α = π/4, β = π/3, γ = π/2},
 Block[{a, c},
  {a, c} = N[ArcCos[{(Cos[α] + Cos[β] Cos[γ])/(Sin[β] Sin[γ]),
                      (Cos[γ] + Cos[α] Cos[β])/(Sin[α] Sin[β])}]]; 
  Graphics3D[{{Opacity[1/2], Sphere[]},
              {Directive[Red, AbsolutePointSize[6]], 
               Point[{{0, 0, 1}, {Sin[c], 0, Cos[c]},
                      {Sin[a] Cos[β], -Sin[a] Sin[β], Cos[a]}}]},
              {Directive[Blue, AbsoluteThickness[3]],
               GreatCircleArc @@@ Partition[{{0, 0}, {0, c}, {-β, a}}, 2, 1, 1]}}, 
             PlotRange -> ConstantArray[{-1, 1}, 3]]]]

spherical triangle from angles

I made the normalization that one of the vertices is always $(\theta,\varphi)=(0,0)$; if you want your triangles to be positioned somewhere else, modifying the routines should not be too difficult.

$\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.