Part of the Journey
This has a simple starting point: the hexagonal lattice packing of the plane by circles. Then we animate by translating: thinking of the plane as the complex numbers, that just means applying the tranformation
$z \mapsto z+t$. This tranformation is 1-periodic, which will make the animation loop. Finally, then, the visually interesting part comes from applying a conformal transformation, which we can realize as a fractional linear transformation
$z \mapsto \frac{az + b}{cz + d}$, corresponding to the matrix
$\begin{pmatrix}a & b \\ c & d \end{pmatrix}$. Following Wikipedia, the transformation with fixed points at
$\gamma_1$ and
$\gamma_2$, pole at
$z_\infty$ (meaning the point sent to infinity by the transformation) and inverse pole
$Z_\infty = \gamma_1 + \gamma_2 - z_\infty$ (meaning the point that infinity maps to) is given by
$\begin{pmatrix}a & b \\ c & d \end{pmatrix} = \begin{pmatrix}Z_\infty & -\gamma_1 \gamma_2 \\ 1 & -z_\infty \end{pmatrix}$
After some playing around, I found that
$\gamma_1 = 2$,
$\gamma_2 = 2i$, and
$z_\infty = \frac{17}{2} e^{i \pi/3}$ looked cool. Composing with
$z \mapsto z+t$ then gives the animation.
I assume @J. M. or @Kuba Podkalicki will pop up later in the thread and show 7 different ways to get dramatic speed-ups in the code, but I couldn't find a way to make this fast enough for a Manipulate[]
. So instead, here's a list of frames:
dots = With[{γ1 = 2, γ2 = 2 I, z∞ = 8.5 E^(I π/3.),
cols = RGBColor /@ {{243, 229, 81}/255, {173, 216, 93}/
255, {101, 188, 183}/255, {93, 140, 210}/255, {195, 116, 175}/
255, {226, 87, 77}/255, {226, 118, 47}/255, "#0D2C54"}},
ParallelTable[
Graphics[
Table[{cols[[Mod[b, 7, 1]]],
Polygon[
Table[ReIm[((γ1 + γ2 - z∞) # - γ1 γ2)/(# - z∞)
&[t + Complex @@ (a {1, 0} + b {1/2, Sqrt[3]/2} + 1/2 {Cos[θ], Sin[θ]})]],
{θ, 0., 2 π, 2 π/100}]]},
{a, -35, 13},
{b, If[a == 0 || a == -1, DeleteCases[Range[-30, 18], c_ /; c == 7 || c == 8 || c == 9], Range[-30, 18]]}],
PlotRange -> 4, ImageSize -> 540, Background -> cols[[-1]]],
{t, 0., 1 - #, #}] &[1/50]
];
...which can be exported to a GIF:
Export[NotebookDirectory[] <> "dots.gif", dots, "DisplayDurations" -> 1/50, "AnimationRepetitions" -> Infinity]