Message Boards Message Boards

[GIF] Limits (Möbius transformations of the triangular tiling)

GROUPS:

Möbius transformations of the triangular tiling

Limits

To make this, I'm applying a family of Möbius transformations $z \mapsto \frac{Z_\infty z - \gamma_1 \gamma_2}{z - z_\infty}$ to the tiling of the plane by equilateral triangles. Specifically, the fixed points of all transformations are $\gamma_1 = 2$ and $\gamma_2 = -2$, and the pole is at $z_\infty = \tan(\pi (t - 1/2))i$ as $t$ varies from 0 to 1. Consequently, the inverse pole (the point to which infinity is sent), is $Z_\infty = \gamma_1 + \gamma_2 - z_\infty = - \tan(\pi (t - 1/2))i$.

In other words, the point infinity gets mapped to just varies along the imaginary axis.

(Actually, there's a slight lie above: I reparametrize $t$ using the smootheststep function in order to get it to pause nicely at the beginning/end).

Of course, I can't really tell Mathematica to transform infinitely many triangles, so the animation actually only shows $1001^2$ triangles, which is why there's a hole in the middle. In some ways the hole annoys me, but I also kind of like it: it's a good reminder of the limits of computation (as opposed to imagination).

Of course, transforming a million triangles doesn't really work in a Manipulate[] (in fact, the animation took many hours to render), so the code below only shows $21^2$ triangles, which is why it has a much larger hole:

smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;

DynamicModule[{γ1 = 2, γ2 = -2, z∞, 
  Z∞, cols = RGBColor /@ {"#eaeaea", "#0D2C54"}},
 Manipulate[
  z∞ = Tan[π (smootheststep[t] - 1/2) ] I;
  Z∞ = γ1 + γ2 - z∞;
  Graphics[
   {cols[[1]],
    Table[
     If[Abs[3/4 y - Tan[π (smootheststep[t] - 1/2)]] < 1/2 && x == 0, Nothing,
      Polygon[
       Flatten[
        Table[
         ReIm[(Z∞ # - γ1 γ2)/(# - z∞) 
           &[Sqrt[3]/2 (x + 1/4 (-1)^Mod[y, 2]) + 3/4 y I + 1/2 ((1 - s) Exp[I (θ)] + s Exp[I (θ + 2 π/3)])]],
         {θ, π/2., 2 π, 2 π/3}, {s, 0., 1, 1/10}],
        1]
       ]
      ],
     {x, -10, 10}, {y, -10, 10}]},
   PlotRange -> {{-((15 Sqrt[3])/8), (15 Sqrt[3])/8}, {-3.25, 3.5}}, ImageSize -> 540, Background -> cols[[-1]]],
  {t, .001, 1 - .001}]
 ]
POSTED BY: Clayton Shonkwiler
Answer
12 days ago

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: Moderation Team
Answer
5 days ago

Group Abstract Group Abstract