This notebook contains additional material to the Mathematica GuideBooks  (Springer-Verlag, New York, 2004) http://www.MathematicaGuideBooks.org . It uses the stylesheet of the Mathematica GuideBooks, which is embedded.

Graphics Volume, Chapter 1

Take (a part of) an aperiodic tiling. Make an animation that rotates the polygons of the tiling around all inner points of the tiling.

(* avoid setting this option for each single graphic *)
SetOptions[Graphics, AspectRatio -> Automatic];

startRhombusA = {{{{1, 0}, {1, 0} + {Cos[72°], Sin[72°]}, 
                   {Cos[72°], Sin[72°]}, {0, 0}, {1, 0}}, "A"}};
                   
startRhombusB = {{{{0, 0}, {1, 0}, {1, 0} + {Cos[36°], Sin[36°]}, 
                   {Cos[36°], Sin[36°]}, {0, 0}}, "B"}};

(* some often occurring rotation matrices *)
ϕ = 1/(2 Cos[Pi/10]);
rm54  = {{ Cos[-54°], Sin[-54°]}, {-Sin[-54°], Cos[-54°]}};
rmp18 = {{ Cos[ 18°], Sin[ 18°]}, {-Sin[ 18°], Cos[ 18°]}};
rmm18 = {{ Cos[-18°], Sin[-18°]}, {-Sin[-18°], Cos[-18°]}};

ruleA := {{p1_, p2_, p3_, p4_, p1_}, "A"} :>
Module[{p5, p6, p7, p8, p9}, (* new points *)
       p5 = p4 + ϕ rm54.(p1 - p4); p6 = p4 + ϕ rmp18.(p1 - p4);
       p7 = p5 + (p1 - p4); p8 = p6 + (p3 - p4); p9 = p5 + p6 - p4;
      Sequence @@ (* delete braces *)
            {{{p5, p4, p6, p9, p5}, "A"}, {{p8, p3, p5, p9, p8}, "A"},
             {{p7, p2, p8, p9, p7}, "A"}, {{p6, p1, p7, p9, p6}, "B"}}]

ruleB := {{p1_, p2_, p3_, p4_, p1_}, "B"} :>
Module[{p5, p6, p7, p8}, (* new points *)
       p7 = p1 + ϕ rm54.(p2 - p1); p5 = p1 + ϕ rmp18.(p2 - p1);
       p6 = p2 + ϕ rmm18.(p3 - p2); p8 = p5 + p7 - p1;
       Sequence @@ (* delete braces *)
      {{{p7, p1, p5, p8, p7}, "A"}, {{p6, p4, p7, p8, p6}, "B"},
       {{p5, p2, p6, p8, p5}, "B"}}]

In the following, we use the tiling at level 6. It has 725 polygons.

s[1] = N[startRhombusA, 30];
s[i_] := s[i] = s[i - 1] /. {ruleA, ruleB}

The polygons and the types of the polygons we collect in the two list polys and polysTypes.

polys = Polygon[Drop[First[#], -1]]& /@ N[s[6]];
polysTypes = Last /@ s[6];

Out of the 790 vertices of the tiling 128 are not inner ones. We find the boundary vertices by counting how frequently the edges of all polygons occur. outerVertex[point] yields True for if point is a vertex on the boundary.

Length[vertices = Union[Level[polys, {-2}]]]

(* group identical line segments of the tiling *)
segments = Split[Sort[Sort /@ Flatten[Partition[Append[#[[1]], 
                  #[[1, 1]]], 2, 1]& /@ Take[polys, All], 1]]];
(* mark boundary polygons *)
If[Length[#] === 1, (boundaryVertex[#] = True)& /@ #[[1]]]& /@ segments;

The list polyτData contains the rotation centers, the polygons to be rotated, the rotation angles, and the colors of the polygons. The parameter τ is the animation parameter and is assumed to vary from 0 to 1.

polyτData = Table[
{(* all inner vertices *)
 DeleteCases[polys[[k]][[1]], _?boundaryVertex], polys[[k]],
 (* color the two polygon types differently *)
 If[polysTypes[[k]] === "A", 1, -1] 2Pi τ, If[polysTypes[[k]] === "A", 0, 0.78] + τ},
 {k, Length[polys]}];

The function makecoloredRotatedPolygon rotates the polygons and adds the τ-dependent coloring.

makecoloredRotatedPolygon[{mps_, poly_, φ_, c_}, τc_] := 
With[{(* rotation matrix *)
      ℛ = {{Cos[#], Sin[#]}, {-Sin[#], Cos[#]}}&[φ /. τ -> τc]},
 {Hue[c /. τ -> τc], {#, {GrayLevel[0], # /. 
                         Polygon[l_] :> Line[Append[l, First[l]]]}}&[
  (* rotate around al inner vertices *)
  Function[mp, Map[(mp + ℛ.(# - mp))&, poly, {-2}]] /@ mps]}]

rotatedTilingFrame[τ_] := 
Graphics[{Thickness[0.001],  makecoloredRotatedPolygon[#, τ]& /@ polyτData},
        AspectRatio -> Automatic, PlotRange -> {{-0.12, 1.5}, {-0.26, 1.1}}];

Here is the resulting animation.

Show[GraphicsArray[rotatedTilingFrame /@ {0, 0.3, 0.5}]]

frames = 120;
Do[Show[rotatedTilingFrame[τ]], {τ, 0, 1 - 1/frames, 1/frames}]