Message Boards Message Boards

[GIF] Flap (Deformations of the Cairo tiling)

Deformations of the Cairo tiling

Flap

I was trying to recreate the Cairo pentagonal tiling and for whatever reason I ended up building it out of two-pentagon pieces connected along the short edge. That visually suggested some sort of butterfly, which naturally led me to making the "butterflies" flap their wings, and here we are.

Here's the code:

DynamicModule[{t = ?/6., s, cols},
 cols = RGBColor /@ {"#FF2E63", "#08D9D6", "#252A34"};
 Manipulate[
  Graphics[{FaceForm[None], EdgeForm[Thickness[.005]], 
    Table[s = ?/3. Haversine[
        Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
       Blend[cols[[;; 2]], 3 s/?]], 
      Polygon[FoldList[
        Plus, {Sqrt[3]
            x Cos[t] - (2 Sqrt[3] y + 
             Sqrt[3] HeavisideTheta[(-1)^x]) Sin[t], 
         Cos[t] (2 Sqrt[3] y + Sqrt[3] HeavisideTheta[(-1)^x]) + 
          Sqrt[3] x Sin[t]}, 
        Table[{Cos[t] Cos[?] - i Cos[i s] Sin[t] Sin[?],
           Cos[?] Sin[t] + 
           i Cos[i s] Cos[t] Sin[?]}, {?, 
          Accumulate[{?/3, ?/2, ?/3, ?/
             2}]}]]]}, {x, -7, 7}, {y, -4, 3}, {i, {-1, 1}}], 
    Table[s = ?/3. Haversine[
        Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
       Blend[cols[[;; 2]], 3 s/?]], 
      Polygon[FoldList[
        Plus, {Cos[
            t] (1/2 (1 - 3 Sqrt[3]) + 2 Sqrt[3] y + 
             Sqrt[3] HeavisideTheta[(-1)^x]) - (1/2 (-1 + Sqrt[3]) + 
             Sqrt[3] x) Sin[t], (1/2 (-1 + Sqrt[3]) + Sqrt[3] x) Cos[
            t] + (1/2 (1 - 3 Sqrt[3]) + 2 Sqrt[3] y + 
             Sqrt[3] HeavisideTheta[(-1)^x]) Sin[t]}, 
        Table[{-Cos[?] Sin[t] + 
           i Cos[i s] Cos[t] Sin[?], 
          Cos[t] Cos[?] + 
           i Cos[i s] Sin[t] Sin[?]}, {?, 
          Accumulate[{?/3, ?/2, ?/3, ?/
             2}]}]]]}, {x, -8, 8}, {y, -3, 4}, {i, {-1, 1}}]}, 
   PlotRange -> 10, ImageSize -> 540, Background -> cols[[3]]], {r, 0,
    2 ?}]]

Now, that code is rather inscrutable-looking, in part because it cut down computation time to expand out various multiplications by RotationMatrix[t]; here's the original code, which is somewhat easier to read but slower:

DynamicModule[{t = ?/6., s, cols},
 cols = RGBColor /@ {"#FF2E63", "#08D9D6", "#252A34"};
 Manipulate[
  Graphics[{FaceForm[None], EdgeForm[Thickness[.005]], 
    Table[s = ?/3. Haversine[
        Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
       Blend[cols[[;; 2]], 3 s/?]], 
      Polygon[FoldList[Plus, 
        RotationMatrix[t].{Sqrt[3] x, 
          2 Sqrt[3] y + Sqrt[3] HeavisideTheta[(-1)^x]}, 
        Table[RotationMatrix[t].{Cos[?], 
           i Cos[i s] Sin[ ?]}, {?, 
          Accumulate[{?/3, ?/2, ?/3, ?/
             2}]}]]]}, {x, -7, 7}, {y, -4, 3}, {i, {-1, 1}}], 
    Table[s = ?/3. Haversine[
        Clip[2 r - 2 ? (x + 7)/14, {0, 2 ?}]]; {EdgeForm[
       Blend[cols[[;; 2]], 3 s/?]], 
      Polygon[FoldList[Plus, 
        RotationMatrix[
          t].{2 Sqrt[3] y + 
           Sqrt[3] HeavisideTheta[(-1)^x] - (3 Sqrt[3] - 1)/2, 
          Sqrt[3] x + (Sqrt[3] - 1)/2}, 
        Table[RotationMatrix[t].{ i Cos[i s] Sin[ ?], 
           Cos[?]}, {?, 
          Accumulate[{?/3, ?/2, ?/3, ?/
             2}]}]]]}, {x, -8, 8}, {y, -3, 4}, {i, {-1, 1}}]}, 
   PlotRange -> 10, ImageSize -> 540, Background -> cols[[3]]], {r, 0,
    2 ?}]]
2 Replies

enter image description here - another post of yours has been selected for the Staff Picks group, congratulations !

We are happy to see you at the tops of the "Featured Contributor" board. Thank you for your wonderful contributions, and please keep them coming!

POSTED BY: EDITORIAL BOARD

Very beautiful! Like a carpet of butterflies. I know @Ed Pegg would appreciate this as he enjoys tilings. I am curious if some nice animations of Penrose tiling are possible.

POSTED BY: Vitaliy Kaurov
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract