Group Abstract Group Abstract

Message Boards Message Boards

[GIF] Stripes (Hyperbolic geodesics)

Hyperbolic geodesics

Stripes

Another animation using the hyperbolic geodesic code explained in more detail here, inspired by this GIF on Tumblr.

In this case, I have two non-antipodal points on the unit circle and pairs of points traveling the two (unequal) arcs between them in the same amount of time, connected by hyperbolic geodesics in the Poincaré disk model (which are just circle arcs perpendicular to the unit circle).

Here's the code:

Stereo[{x_, y_, z_}] := {x/(1 + z), y/(1 + z)};
InverseStereo[{x_, y_}] := 1/(1 + x^2 + y^2) {2 x, 2 y, 1 - x^2 - y^2};
hypgeo[p1_, p2_, t_] := 
  Stereo[Append[#, 
      Sqrt[1 - Norm[#]^2]]] &[(1 - t) InverseStereo[p1][[;; 2]] + 
    t InverseStereo[p2][[;; 2]]];

DynamicModule[{cols = 
   RGBColor /@ {"#EDF2F6", "#FF5656", "#6A7EFC", "#494953"},
  n = 3,
  m = 72,
  pts,
  t
  },
 Manipulate[
    t = Mod[s, n/m];
    pts = 
     Table[{{Cos[2 ?/n (t + a) + ?/6], 
        Sin[2 ?/n (t + a) + ?/6]},
       {Cos[-2 (n - 1) ?/n (t + a) + ?/6], 
        Sin[-2 (n - 1) ?/n (t + a) + ?/6]}},
      {a, 0, 1 - n/m, n/m}];
    Show[
     ParametricPlot[
      Evaluate[hypgeo[#[[1]], #[[2]], r] & /@ pts], {r, 0, 1},
      PlotStyle -> (If[EvenQ[Floor[s/(n/m)]], #, 
           Reverse[#]] &[{Directive[cols[[3]], Thickness[.00275]], 
          Directive[cols[[2]], Thickness[.00275]]}]), Axes -> False],
     Graphics[{Thickness[.004], cols[[1]], Circle[], cols[[2]]}],
     Background -> cols[[-1]], PlotRange -> 1.2, ImageSize -> 540
     ],
    {s, 0., 2 n/m - #, #}] &[n/(24 m)]
 ]
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