Penrose Tilings
by Pedro Willging

The Penrose tilings are a class of beautiful nonperiodic tilings, which lately have been useful in helping scientist studying crystalography to understand quasicrystals structure. Tilings of the plane have been studied for centuries because of decorative and mathematical use. Before going any further with Penrose tilings, we need some definitions, and background.

A set T of regions tiles the plane if the entire plane can be covered by copies of  regions in T so that these copies have no interior points in common. A periodic tiling is one in which the region tiles the plane by translation. M.C. Escher is famous for his artistic periodic tiling.

Figure 1: A periodic tessellation by M.C. Escher (1949)

A set of tiles is called aperiodic if it tiles the plane, but it is not possible to use the tiles to cover the plane periodically.

H. Wang cojectured that any set of tiles which can tile the plane can tile it periodically, but R. Berger (1964) showed that Wang's conjecture is false by constructing a set of tiles that tiles only nonperiodically. Berger's set contained 20,426 tiles. That number was reduced to 6 by R. Robinson and surprinsingly to only 2 simple shapes, called the kite and dart, by R. Penrose.

Constructing the tiles

We can construct the kite and dart using a rhombus with angles 72 and 108 degrees. We need to divide the long diagonal in the golden ratio (1 + (Sqrt[5]))/2 and then join the point to the obtuse corners.

Figure 2: Constructing the kite and dart

In that way we get the well-known shapes kite and dart.

Figure 3: Kite and Dart

We can tile the space periodically with rhombus, but we are not allowed to do that because these pieces have specific rules for joining them. If we label the corners with H and T, the rule is that in fitting edges only corners of the same letter may meet. Conway proposed a much more elegant method, which consists in drawing circular arcs of two colors on each tile. The axis of symmetry and the sides are cut by each arc in the golden ratio. The rule is that adjacent edges must join arcs of the same color.

Figure 4: Rules for joining kites and darts

Examples:

Figure 5: Ace, and Short Bow Tie

Another way of constructing the tiles is using two types of isosceles triangles, which are called type +1 (72 - 72 - 36 ) and type -1 (36 - 36 - 108 ).

Figure 6: Type +1 and -1 triangles.

The vertices of these triangles are colored blue or red as indicated in Figure 6, and with the monochromatic side directed away from the longer of the other two sides ( see the arrow in Figure 6). If we divide these triangles using the golden ratio we can see that we get two new triangles, one of type +1 and one of type -1.

Figure 7: Dissection procedure

Note: See that  ϕ - 1 = 1/ϕ  and  (ϕ^2) = ϕ + 1

The kite and dart can be obtained by joining two type +1 triangles and the dart using two type -1 triangles.

Figure 8: Kite and Dart

We can obtain a nonperiodic tiling by repeatedly dissecting a type +1 triangle. We split the starting triangle in two triangles, one type +1 and one type -1,  then we split the type -1 to get another  type +1 triangle and one type -1 (a total of three triangles so far). We continue dissecting the two typw +1 triangles to get 5 triangles, and so on.
A tiling constructed in such a way, i.e., using triangles type +1 (sides 1, ϕ, ϕ) and type -1 (sides ϕ, 1, 1), is called an A-tiling. It should be noticed that at each stage of the dissecting process, the total number of tiles, the number of type +1 tiles, and the number of type -1 tiles are consecutive Fibonacci numbers.

What follows is the implementation of the A-tiling using some Mathematica code:

phi = GoldenRatio  // N;
toppoint = {1/2,  Sin[72 Degree] phi}  // 
          N;
starttriangle = {toppoint,  {1, 0. }, {0. , 0. }, 
          1};
x1 :=  
        First[x /. 
            N[Solve[Tan[72 Degree] x  ==  1 -  2  x ,  
                x]]];
x2 := 1 - x1;
y1 := 0;
\(\(y2 := 1 - 2\ x1;\)
\)
dissect[{p_, q_, r_, 
          1}] :=  (newpoint = (phi  q + p)*(2 -  
                phi); 
{{r, newpoint, q, 1}, {r, 
            newpoint, p, -1}})
dissect[{p_, q_, 
          r_, -1}] :=  (newpoint = (phi  r + p)*(2 - 
                phi); 
{{r, newpoint, q, -1}, {p, q, 
            newpoint, 1}})
dissect[
        list_] := (type  *= -1; 
Join[ 
          Select[list,  
            Function[Last[#]  ≠ type]] , 
 
          Flatten[Map[dissect,  
              Select[list,  Function[Last[#] == type]]], 
            1 ] ])

TriangleDissection[
        n_] := (type = 1; 
tiles = 
          Nest[dissect,  starttriangle, 
              n] /. {p_, q_, r_, x_} -> {Line[{q, r, p}],  
                Thickness[ .015],  
                Line[{p, q}]}; 

Show[
          Graphics[{Thickness[ .0005],  tiles}],  
          AspectRatio -> toppoint[[2]],  
          PlotRange -> 
            All])

Attributes[TriangleDissection] = Listable

TriangleDissection[Range[10]]

The thicker lines in these graphs are the directed sides.

It can be demonstrated that these repeated dissections imply that an infinitely number of copies of triangles type +1 and type -1 can be used to tile the plane. We can see the triangles resulting from the second dissection inside the triangle resulting from the fourth step in the process, provided that we enlarge and rotate it. We can see that the 8 triangles in the fourth step can be located between the 21 triangles resulting in the sixth step of the dissection. The entire plane can be covered by keeping going on with this process.

Figure 9  :  Second, fourth, 
    and sixth triangles.

\(The\ proof\ that\ the\ tiling\ is\ aperiodic\ comes\ from\ the\ fact\ that\ the\ ratio\ between\ the\ type + 1\ and\ type - 
        1\ triangles\ is\ the\ limit\ of\ the\ ratio\ of\ consecutive\ Fibonacci\ numbers\),which is the irrational number (1+(Sqrt[5]))/2

Kite-and - Dart  tiling

Since we can obtain the kite and dart by using the type +1 and type -1 triangles, provided that we join them along their common directed edge, we can make an aperiodic set for tilings that match the colors of the vertices.

KitesAndDarts[
        n_] := (type = 1; 
tiles = 
          Nest[dissect,  starttriangle, 
              2  n]  /. { {p_, q_, 
                  r_, -1} -> {RGBColor[1, 1, 0],  
                  Polygon[{q, r, p}], RGBColor[0, 0, 0], 
                  Line[{q, r, p}]},  {p_, q_, r_, 
                  1} -> {RGBColor[0, 0, 1],  Polygon[{q, r, p}], 
                  RGBColor[1, 1, 1], 
                  Line[{q, r, p}]} }; 
Show[
          Graphics[{Thickness[ .0005],  tiles}], 
          AspectRatio -> Automatic,  
          PlotRange -> {{x1, x2}, {y1, 
                y2}}])

Attributes[KitesAndDarts] = Listable

KitesAndDarts[Range[7]]

Here we have shown the largest square that can be inscribed in the initial triangle.

Rhombus tiling

Tilings of the plane that use a type +1 triangle with sides 1, ϕ, and ϕ, and type -1 triangle with sides ϕ+1, ϕ, and ϕ are called B-Tilings.

In this case, the shapes we will use are made by joining two type +1 triangles by their short side, which yield a thin rhombus, and by joining two type -1 triangles by their long edge, which yield a thick rhombus.

Rhombs[
        n_] := (type = 1; 
tiles = 
          Nest[dissect,  starttriangle, 
              2  n + 1]  /. { {p_, q_, r_, 1} -> 
                Line[{r, p, q}],  {p_, q_, 
                  r_, -1} -> {{RGBColor[1,  .75, 0],  
                    Polygon[{p, q, r}]}, 
                  Line[{p, q, r}]} }; 
Show[
          Graphics[{Thickness[ .003],  tiles}],  
          AspectRatio -> Automatic,  
          PlotRange -> {{x1, x2}, {y1, 
                y2}}])

Attributes[Rhombs] = Listable

Rhombs[Range[7]]

Suggestion:Animate the graphs, and experiment with the dissection program by changing the number of iterations in  the line Rhombs[Range[7]]. Try 10, and 12 instead of 7.

I hope that this introduction to tilings motivates you to make a deeper research about this topic.

Bibliography

Gardner, M. (1989). Penrose tiles to trapdoor ciphers. New York: W. H. Freeman and Company.

Wagon, S. (1991). Mathematica in Action. New York: W. H. Freeman and Company.

Wolfram, S. (1988). Mathematica: A system for doing Mathematics by Computer. New York: Addison-Wesley Publishing Company, Inc.

Figures

phi = GoldenRatio // N;

Figure 2

v1 = { phi Cos[72 Degree],  
          phi Sin[72 Degree]};
v2 = {phi  +  phi Cos[72 Degree],  
          phi Sin[72 Degree]};
v3 = {phi,  0};
vert = {{0, 0},  v1,  v2, 
          v3 ,  {0, 0} };
parallelograme := 
        ListPlot[vert,  PlotJoined  ->  True, 
          DisplayFunction  ->  Identity];
cpoint := {phi Cos[36 Degree],  
          phi Sin[36 Degree]};
line13 := 
        ListPlot[{v1,  cpoint,  v3},  PlotJoined  ->  True, 
          DisplayFunction  ->  Identity];
diag := 
        ListPlot[{{0, 0}, v2},  PlotJoined  ->  True,  
          PlotStyle ->  Dashing[{0.05, 0.05}], 
          DisplayFunction  ->  
            Identity];

textnull := 
        Graphics[RGBColor[0, 0, 1], 
          Text[" ", {0, 0}]];
text1 := 
        Graphics[
          Text["ϕ",  {phi/
                2,  - .1}]];
text2 := 
        Graphics[
          Text["ϕ",  {phi/2,   .5}]];
text3 := 
        Graphics[
          Text["ϕ",  { .5  +  phi/2,  
              phi  +  .05}]];
text4 := 
        Graphics[
          Text["ϕ",  { .15 ,   .85}]];
text5 := 
        Graphics[
          Text["ϕ",  { .5  +  
                phi,  .85}]];
text6 := 
        Graphics[
          Text["1",  { .55  +  
                phi/2,   .60}]];
text7 := 
        Graphics[
          Text["1",  {phi/2,  1.2}]];
text8 := 
        Graphics[
          Text["1",  {1.5  ,  1.25}]];
text9 := 
        Graphics[
          
          Text["36°",  { .2,   .2}]];
text10 := 
        Graphics[
          Text["36°",  { .3,   .1}]];
text11 := 
        Graphics[
          Text["36°",  {phi/2  -   .1,  
              phi  -  .15}]];
text12 := 
        Graphics[
          Text["36°",  {phi  +   .3,  
              phi  -  .15}]];
text13 := 
        Graphics[
          Text["36°",  {phi  +   .35,  
              phi  -  .3}]];
\(\(text14 := 
        Graphics[
          Text[\*"" ϕ=\!\(\(1\\\\  + \\\\ \@5\)\/2\)       "", \ {phi +  .75,  .5}]];\)\)
text15 := 
        Graphics[
          Text["72°",  {phi/2  -   .25,  
              phi  -  .3}]];
text16 := 
        Graphics[
          Text["72°",  {phi  -   .15,   .1}]];
\(\(text17 := 
        Graphics[
          Text["36°", \ {phi +  .04\ , \  .3}]];\)
\)
Show[parallelograme, diag,  line13, textnull,  text1, text2, text3, 
        text4, text5, text6, text7, text8, text9, text10,  text11, text12, 
        text13, text14,  text15,  text16,  text17, 
        DisplayFunction  ->  $DisplayFunction,  
        Axes  ->  False];

Figure 3

<< "Graphics`Colors`"

kvert := {{0, 0}, {- phi Sin[36 Degree],  
            phi Cos[36 Degree]}, {0,  phi},  {phi Sin[36 Degree],  
            phi Cos[36 Degree]},  {0, 0}};
kite := 
        ListPlot[kvert,  PlotJoined  -> True,  
          PlotStyle -> {Thickness[0.01],  Blue},  
          DisplayFunction  ->  Identity];
kdiag := 
        ListPlot[{{0, 0}, {0,  phi}},  PlotJoined  ->  True,  
          PlotStyle ->  Dashing[{0.05, 0.05}], 
          DisplayFunction  ->  Identity];
Show[kite,  kdiag,  DisplayFunction  ->  $DisplayFunction,  
      Axes  ->  False]

dvert := {{-Cos[18 Degree], 0}, {0, 
            1 +  Sin[18 Degree]}, {Cos[18 Degree],  0},  {0,  
            Sin[18 Degree]},  {-Cos[18 Degree], 
            0}};
dart := 
        ListPlot[dvert,  PlotJoined  -> True, 
          PlotStyle -> Thickness[0.01], 
          DisplayFunction  ->  Identity];
ddiag := 
        ListPlot[{{0, 1 +  Sin[18 Degree]}, {0,  Sin[18 Degree]}},  
          PlotJoined  ->  True,  
          PlotStyle ->  Dashing[{0.05, 0.05}], 
          DisplayFunction  ->  Identity];
Show[dart,  ddiag,  DisplayFunction  ->  $DisplayFunction,  
      Axes  ->  False]

Figure 4

bigkvert := {{0, 
            0}, {- (1 + phi) Sin[36 Degree],  (1 + phi) Cos[
                36 Degree]}, {0,  
            1 + phi},  {(1 + phi) Sin[36 Degree],  (1 + phi) Cos[
                36 Degree]},  {0, 0}};
bigkite := 
        ListPlot[bigkvert,  PlotJoined  -> True,  
          PlotStyle  -> Thickness[0.01], 
          DisplayFunction  ->  Identity];
bigkdiag := 
        ListPlot[{{0, 0}, {0,  1 +  phi}},  PlotJoined  ->  True,  
          PlotStyle ->  Dashing[{0.05, 0.05}], 
          DisplayFunction  ->  
            Identity];

arc1 := 
        Graphics[{Thickness[0.01], RGBColor[0, 1, 0], 
            Circle[{0,  1 +  phi}, 
              1, {11 π/10, 
                19 π/10}]}];
arc2 := 
        Graphics[{Thickness[0.01], RGBColor[1, 1, 0], 
            Circle[{0, 0}, phi, {3 π/10, 7 π/10}],  
            RGBColor[0, 1, 
              0]}];

textnullc := 
        Graphics[RGBColor[0, 0, 1], 
          Text[" ", {0, 0}]];
textc1 := 
        Graphics[
          Text["ϕ",  { .2  -  
                phi/2,   .5}]];
textc2 := 
        Graphics[
          Text["ϕ",  {phi/
                  2  -   .2,   .5}]];
textc3 := 
        Graphics[
          Text["ϕ",  { .1 ,  
              phi -   .3 }]];
textc4 := 
        Graphics[
          Text["1/ϕ",  {-phi/2  -  .5,  
              2.3}]];
textc5 := 
        Graphics[
          Text["1/ϕ",  { phi/2  +  .5 , 
              2.3}]];
textc6 := 
        Graphics[
          Text["1",  {-phi/2  -  .6,  
              1.8}]];
textc7 := 
        Graphics[
          Text["1",  {phi/2 +   .6,  
              1.8}]];
textc8 := 
        Graphics[
          Text["1",  { .1 ,  
              phi +  .5}]];
textc9 := 
        Graphics[
          Text["1",  { .2  -  phi/2,  
              2.5}]];
textc10 := 
        Graphics[
          Text["1",  { phi/2 -   .2,  
              2.5}]];
textc11 := 
        Graphics[
          Text["T",  {0, - .1}]];
textc12 := 
        Graphics[
          Text["T",  {0,  phi  + 1.1}]];
textc13 := 
        Graphics[
          Text["H",  {-phi , 2.1}]];
textc14 := 
        Graphics[Text["H",  {phi, 2.1}]];
textc15 := 
        Graphics[
          Text["  Kite", {-2, 
              0}]];

Show[bigkite, bigkdiag,  arc1,  arc2, textnullc, textc1,  textc2,  
      textc3,  textc4, textc5,  textc6,  textc7, textc8,  textc9,  
      textc10, textc11,  textc12,  textc13,  textc14,  textc15, 
      DisplayFunction  ->  $DisplayFunction,  
      Axes  ->  False]

bigdvert := {{-phi Cos[18 Degree], 0}, {0, 
            phi + phi  Sin[18 Degree]}, {phi Cos[18 Degree],  
            0},  {0,  
            phi Sin[18 Degree]},  {- phi Cos[18 Degree], 
            0}};
bigdart := 
        ListPlot[bigdvert,  PlotJoined  -> True, 
          PlotStyle  -> Thickness[0.01], 
          DisplayFunction  ->  Identity];
bigddiag := 
        ListPlot[{{0, phi + phi  Sin[18 Degree]}, {0, 
              phi Sin[18 Degree]}},  PlotJoined  ->  True,  
          PlotStyle ->  Dashing[{0.05, 0.05}], 
          DisplayFunction  ->  
            Identity];

arcd1 := 
        Graphics[{Thickness[0.01], RGBColor[1, 1, 0], 
            Circle[{0,  phi +  phi Sin[18 Degree]}, 
              1, {13 π/10, 
                17 π/10}]}];
arcd2 := 
        Graphics[{Thickness[0.01], RGBColor[0, 1, 0], 
            Circle[{0, phi Sin[18 Degree]}, 
              1/phi, {- π/10, 
                11 π/
                    10}]}];

textnulld := 
        Graphics[RGBColor[0, 0, 1], 
          Text[" ", {0, 0}]];
textd1 := 
        Graphics[
          Text["ϕ",  {- phi +  .7,  
              1}]];
textd2 := 
        Graphics[
          Text["ϕ",  {phi -  .7,  
              1}]];
textd3 := 
        Graphics[
          Text["1/ϕ",  { .1 ,   .8 }]];
textd4 := 
        Graphics[
          Text["1/ϕ",  {- .3,   .5}]];
textd5 := 
        Graphics[
          Text["1/ϕ",  {  .3,  .5}]];
textd6 := 
        Graphics[Text["1",  { .1,  1.6}]];
textd7 := 
        Graphics[
          Text["1",  {-  .3,  1.8}]];
textd8 := 
        Graphics[Text["1",  { .3,  1.8}]];
textd9 := 
        Graphics[
          Text["1",  {-1. ,   .1}]];
textd10 := 
        Graphics[
          Text["1",  {  1. ,   .3}]];
textd11 := 
        Graphics[Text["H",  {0,  .3}]];
textd12 := 
        Graphics[
          Text["H",  {0,  phi  +  .6}]];
textd13 := 
        Graphics[
          Text["T",  {-phi , 0}]];
textd14 := 
        Graphics[Text["T",  {phi, 0}]];
textd15 := 
        Graphics[
          Text["  Dart", {0, - .3}]];

Show[bigdart,  bigddiag,  arcd1, arcd2, textnulld,  textd1,  
      textd2,  textd3,  textd4,  textd5,   textd6,  textd7,  
      textd8,    textd9,  textd10,  textd11,  textd12,  textd13,  
      textd14,  textd15, DisplayFunction  ->  $DisplayFunction,  
      Axes  ->  False]