Message Boards Message Boards

[GIF] Send/Receive (Stereographic projection of latitude/longitude grid)

Stereographic projection of latitude/longitude grid

Send/Receive

This one is fairly simple: form the latitude/longitude grid where the "north" and "south" poles are the points $(0,1,0)$ and $(0,-1,0)$, rotate the longitudes and simultaneously push the latitudes down, then stereographically project the whole thing to the plane. The motion makes the most sense in modified spherical coordinates (swapping the roles of the $y$- and $z$-axes), and I probably could have used some version of CoordinateTransform[] to translate from spherical to rectangular coordinates if I hadn't just converted it in my head.

Some messing around with Blend[] and VertexColors gives the final continuous gradient of colors.

Here's the code:

Stereo[{x_, y_, z_}] := {x/(1 - z), y/(1 - z)};

With[{n = 15, cols = RGBColor /@ {"#FF7A5A", "#50E3C2", "#432160"}},
 Manipulate[
  Graphics[{
    Thickness[.004],
    Table[
     {Line[
       Table[Stereo[{Cos[? + s] Sin[t], Cos[t], Sin[? + s] Sin[t]}], {t, 0, ?, ?/100}],
       VertexColors -> Table[Blend[cols[[;; 2]], a], {a, 0, 1, 1/101}]]},
     {?, 0, 2 ? - ?/n, ?/n}],
    Table[
     {Blend[cols[[;; 2]], Mod[(?/2 + s)/(?), ?]],
      Line[
       Table[
        Stereo[{Sin[?/2 + s] Cos[t], Cos[?/2 + s], Sin[?/2 + s] Sin[t]}],
        {t, 0, 2 ?, 2 ?/100}]]},
     {?, 0, 2 ? - 2 ?/n, 2 ?/n}],
    cols[[1]], Disk[{0, 1}, .02], cols[[2]], Disk[{0, -1}, .02]},
   PlotRange -> 2, ImageSize -> 540, Background -> cols[[-1]]],
  {s, 0., ?/n}]
 ]

enter image description here - Congratulations! This post is now a Staff Pick as distinguished by a badge on your profile! Thank you, keep it coming!

POSTED BY: EDITORIAL BOARD
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract