# Triangle mapped on a sphere in $\mathbb R^3$?

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.

• Seen this? Commented Apr 10, 2013 at 8:44
• 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. Commented Apr 10, 2013 at 14:18
• @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. :-) Commented Apr 10, 2013 at 14:23
• @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? Commented Apr 10, 2013 at 16:53
• @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. Commented Apr 11, 2013 at 13:14

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
]


• Thanks for the time you took. Commented Apr 10, 2013 at 14:25
• What a code, huh. :D
– BoLe
Commented Apr 11, 2013 at 13:13
• +1 anyway because of all the fuss with the migration :-) Commented Apr 11, 2013 at 13:23
• 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? Commented Apr 13, 2013 at 23:19
• @Martin, Wizard here is still on version seven, if memory serves... Commented Apr 14, 2013 at 17:58

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]]]]


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]]]]


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.