[GIF] Part of the Journey (Conformally transformed hex circle packing)

Posted 1 year ago
2570 Views
|
4 Replies
|
13 Total Likes
|
 Part of the JourneyThis 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]
4 Replies
Sort By:
Posted 1 year ago
 I should point out that this business: If[a == 0 || a == -1, DeleteCases[Range[-30, 18], c_ /; c == 7 || c == 8 || c == 9], Range[-30, 18]] is to delete the disks which have a point in their interior get mapped to infinity (which should turn the disk inside-out, but Polygon[] doesn't work that way, and you just get a giant solid blob covering everything else).
Posted 1 year ago
 - Congratulations! This post is now a Staff Pick as distinguished on your profile! Thank you, keep it coming!