Group Abstract

Message Boards

[GIF] This is Only a Test (Decagons from stereographic projections)

Clayton Shonkwiler, Colorado State University

Posted 7 years ago

This is Only a Test This one is fairly straightforward. Form 60 concentric circles on the sphere centered at the point $(0,1,0)$ . On each circle, take 10 equally-spaced points, stereographically project to the plane, and form a decagon from the resulting points. Now rotate the sphere and all the points on it around the axis $(0,1,0)$ . The result (at least after adding some color) is this animation. This is a sort of discretized companion to my old still piece Dipole. Here's the code: Stereo[p_] := p[[;; -2]]/(1 - p[[-1]]); With[{r = 2, n = 10, m = 60, cols = RGBColor /@ {"#2EC4B6", "#011627", "#E71D36"}}, Manipulate[ Graphics[ {EdgeForm[Thickness[.0045]], Join[{Reverse[#[[1]]], #[[2]]}] &[Partition[ Table[ {Blend[cols, ?/?], EdgeForm[Lighter[Blend[cols, ?/?], .15]], Polygon[ Table[Stereo[(Cos[?] {0, 1, 0} + Sin[?] {Cos[t], 0, Sin[t]}).RotationMatrix[?, {0, 1, 0}]], {t, ?/2, 5 ?/2, 2 ?/n}]]}, {?, ?/(2 m), ? - ?/(2 m), ?/m}], m/2]]}, PlotRange -> r, ImageSize -> 540, Background -> Blend[cols, 1/2]], {?, 0, 2 ?/n}] ]

Decagons formed from stereographically projected points

This is Only a Test

This one is fairly straightforward. Form 60 concentric circles on the sphere centered at the point $(0,1,0)$ . On each circle, take 10 equally-spaced points, stereographically project to the plane, and form a decagon from the resulting points. Now rotate the sphere and all the points on it around the axis $(0,1,0)$ . The result (at least after adding some color) is this animation. This is a sort of discretized companion to my old still piece Dipole.

Here's the code:

Stereo[p_] := p[[;; -2]]/(1 - p[[-1]]);

With[{r = 2, n = 10, m = 60, 
  cols = RGBColor /@ {"#2EC4B6", "#011627", "#E71D36"}},
 Manipulate[
  Graphics[
   {EdgeForm[Thickness[.0045]],
    Join[{Reverse[#[[1]]], #[[2]]}]
      &[Partition[
      Table[
       {Blend[cols, ?/?], 
        EdgeForm[Lighter[Blend[cols, ?/?], .15]],
        Polygon[
         Table[Stereo[(Cos[?] {0, 1, 0} + 
              Sin[?] {Cos[t], 0, Sin[t]}).RotationMatrix[?, {0, 1, 0}]],
          {t, ?/2, 5 ?/2, 2 ?/n}]]},
       {?, ?/(2 m), ? - ?/(2 m), ?/m}],
      m/2]]},
   PlotRange -> r, ImageSize -> 540, Background -> Blend[cols, 1/2]],
  {?, 0, 2 ?/n}]
 ]

POSTED BY: Clayton Shonkwiler