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

replaced http://mathematica.stackexchange.com/ with https://mathematica.stackexchange.com/

Source Link

edited Apr 13, 2017 at 12:55

1

In the comments J. M.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

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

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

shorten and streamline code

Source Link

edited Apr 11, 2013 at 14:38

Mr.Wizard

273.1k
34
595
1.4k

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

Here is code from that, with my own refactoring:

eps = 10^-6;

(* from spherical to cartesian coordinates *)
sp[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]},
   Black, Opacity[1]ark[#,
   Line[ark[{sp[p1],20] sp[p2]},& 20]],
/@ Subsets[sp /@ Line[ark[{sp[p1]p1, sp[p3]}p2, 20]]p3},
   Line[ark[{sp[p3], sp[p2]2},] 20]]// Line,
   PointSize[.015],
   PointPoint[sp /@ {sp[p1]p1, sp[p2]p2, sp[p3]p3}]
  },
  Boxed -> False,
  ImageSize -> {400, 400},
  FaceGrids -> {{0, 0, -1}},
  FaceGridsStyle -> GrayLevel[.5]]5]
 ],
 {{p1, {4.2, .5}, "point one"}, {eps, \[Pi]π (1 - eps)}, {2 \[Pi]π (1 - eps), eps}},
 {{p2, {.1, 1.1}, "point two"}, {eps, \[Pi]π (1 - eps)}, {2 \[Pi]π (1 - eps), eps}},
 {{p3, {5.1, 1.8}, "point three"}, {eps, \[Pi]π (1 - eps)}, {2 \[Pi]π (1 - eps), eps}},
 ControlPlacement -> Left,
  SaveDefinitions -> True]True
]

enter image description here

In the comments J. M. linked to a Demonstration by Borut Levart. Here is code from that:

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],
   Black, Opacity[1],
   Line[ark[{sp[p1], sp[p2]}, 20]],
   Line[ark[{sp[p1], sp[p3]}, 20]],
   Line[ark[{sp[p3], sp[p2]}, 20]],
   PointSize[.015],
   Point /@ {sp[p1], sp[p2], sp[p3]}},
  Boxed -> False,
  ImageSize -> {400, 400},
  FaceGrids -> {{0, 0, -1}},
  FaceGridsStyle -> GrayLevel[.5]],
 {{p1, {4.2, .5}, "point one"}, {eps, \[Pi] (1 - eps)}, {2 \[Pi] (1 - eps), eps}},
 {{p2, {.1, 1.1}, "point two"}, {eps, \[Pi] (1 - eps)}, {2 \[Pi] (1 - eps), eps}},
 {{p3, {5.1, 1.8}, "point three"}, {eps, \[Pi] (1 - eps)}, {2 \[Pi] (1 - eps), eps}},
 ControlPlacement -> Left,
  SaveDefinitions -> True]

enter image description here

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

Post Migrated Away to math.stackexchange.com

occurred Apr 10, 2013 at 16:16

Source Link

created Apr 10, 2013 at 9:07

Mr.Wizard

273.1k
34
595
1.4k

In the comments J. M. linked to a Demonstration by Borut Levart. Here is code from that:

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],
   Black, Opacity[1],
   Line[ark[{sp[p1], sp[p2]}, 20]],
   Line[ark[{sp[p1], sp[p3]}, 20]],
   Line[ark[{sp[p3], sp[p2]}, 20]],
   PointSize[.015],
   Point /@ {sp[p1], sp[p2], sp[p3]}},
  Boxed -> False,
  ImageSize -> {400, 400},
  FaceGrids -> {{0, 0, -1}},
  FaceGridsStyle -> GrayLevel[.5]],
 {{p1, {4.2, .5}, "point one"}, {eps, \[Pi] (1 - eps)}, {2 \[Pi] (1 - eps), eps}},
 {{p2, {.1, 1.1}, "point two"}, {eps, \[Pi] (1 - eps)}, {2 \[Pi] (1 - eps), eps}},
 {{p3, {5.1, 1.8}, "point three"}, {eps, \[Pi] (1 - eps)}, {2 \[Pi] (1 - eps), eps}},
 ControlPlacement -> Left,
 SaveDefinitions -> True]

enter image description here

Stack Exchange Network

Return to Answer