20
$\begingroup$

Say I want to represent points of the complex plane in the sphere $\Bbb S^2$ using stereographic projection. That is, the Riemann sphere:

Riemann Sphere

Specifically, it would be nice to be able to:

  1. Given the coordinates $(x,y)$ of a point of the plane, see the point and its spherical image, and optionally, the line through the north pole and $(x,y,0)$.
  2. Given a circle in the plane, (that is, its center $(x,y)$ and its radius $r\gt 0$), see the circle and its spherical image.
  3. Optionally: it would be nice as well but is not necessary, being able to project in the sphere other kinds of sets, say polygons, sets of points, maybe straight lines, etc.

How can we do this? Is this already possible in Mathematica, I mean as built in functions?

This is an idea for your use:

enter image description here

$\endgroup$
7
  • $\begingroup$ This came to me by trying to solve this problem. See this to see where I'm having troubles. I think most of my confusion will disappear by seeing some drawings. $\endgroup$
    – leo
    Commented Apr 22, 2013 at 18:04
  • 1
    $\begingroup$ btw you might find something useful for you problem in Mathematica. $\endgroup$
    – Silvia
    Commented Apr 22, 2013 at 18:14
  • 1
    $\begingroup$ also useful: Riemann sphere $\endgroup$
    – cormullion
    Commented Apr 22, 2013 at 18:55
  • 1
    $\begingroup$ A search on "stereographic" produces many solutions (including in more dimensions). $\endgroup$
    – whuber
    Commented Apr 22, 2013 at 19:45
  • 1
    $\begingroup$ @J.M. Modesty :-) $\endgroup$
    – whuber
    Commented Apr 23, 2013 at 14:28

2 Answers 2

18
$\begingroup$

I think you can do like this:

f[{x_, y_}] := {(2 x)/(1 + x^2 + y^2), (2 y)/(
  1 + x^2 + y^2), (-1 + x^2 + y^2)/(1 + x^2 + y^2)}

for points:

Manipulate[
 Graphics3D[{{Black, PointSize[Large], Point[{0, 0, 1}]}, {Black, 
    PointSize[Large], Point[Append[pt, 0]]}, {Pink, PointSize[Large], 
    Point[f[pt]]}, {Opacity[0.2], Sphere[]}, {Opacity[0.2], 
    Cuboid[{-2.1, -2.1, -.01}, {2.1, 2.1, 0}]}, {Line[{{0, 0, 1}, 
      f[pt], Append[pt, 0]}]}}, 
  PlotRange -> 2], {pt, {-2, -2}, {2, 2}}]

enter image description here

for a general line:

p = Plot[Sin[2 x], {x, 0, π}];
pts = Cases[p, Line[x__] :> x, ∞][[1]];
Graphics3D[{{Pink, Line[f /@ pts]}, {Opacity[0.2], Sphere[]}, {Black, 
   Line[pts /. {x_, y_} -> {x, y, 0}]}}]

enter image description here

for circle:

Manipulate[
 Block[{cc, pts}, 
  cc = ParametricPlot[
    pt0 + {r0 Cos[θ], r0 Sin[θ]}, {θ, 0, 
     2 π}];
  pts = Cases[cc, Line[x__] :> x, ∞][[1]]; 
  Graphics3D[{{Pink, Line[f /@ pts]}, {Opacity[0.2], 
     Sphere[]}, {Black, Line[pts /. {x_, y_} -> {x, y, 0}]}}, 
   PlotRange -> 2.5]], {{pt0, {0, 0}}, {-2, -2}, {2, 2}}, {{r0, 0.2}, 
  0, 1}]

enter image description here

$\endgroup$
1
  • $\begingroup$ I get a red box output stating that "coordinates$cellCOntext should be triple of numbers or scaled form" in version 12.3. How would I rectify this? $\endgroup$ Commented Nov 12, 2021 at 8:15
4
$\begingroup$

Just to extend the answer of @user0501 (a little) using the definition of f:

pp[x_] := 
 ParametricPlot3D[ f[{x + u, y}], {u, 0, 0.1}, {y, -1, 1}, 
  Mesh -> None]
ppy[y_] := 
 ParametricPlot3D[ f[{x, y + u}], {u, 0, 0.1}, {x, -1, 1}, 
  Mesh -> None]
Show[Table[pp[j], {j, -1, 1, 0.25}]~Join~
  Table[ppy[j], {j, -1, 1, 0.25}], 
 PlotRange -> {{-1, 1}, {-1, 1}, {-1, 1}}, Background -> Black, 
 Boxed -> False]

enter image description here

$\endgroup$

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