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}]
]
– you have earned Featured Contributor Badge 