(*: Title: PenroseTiles *)
(*: Author: Lyman P. Hurd *)
(*: Copyright: Copyright 1994, Lyman P. Hurd *)
(*: Package Version: 1.0 *)
(*: Mathematica Version: 2.0 *)
(*: Summary:
This package includes some functions for deflating patterns
of Penrose dart and kite tiles.
*)
(*:Keywords: aperiodic, tiling, penrose
*)
(*:Discussion: *)
(*:Context: PenroseTiles` *)
(*:Source:
A similar package was shown to the author by William Thurston
around 1988. The work here bears an unknown degree of similarity
since it derives from memory and experimentation.
*)
(*:History:
*)
BeginPackage["PenroseTiles`"]
Deflate::usage =
"Deflate[list] takes a collection of acute and obtuse triangles
forming Penrose tiles and yields a larger deflated list.
Deflate[list,n] deflates the list n times."
LineGraph::usage =
"LineGraph[list] converts a list of triangles to an object of type
Graphics in which tiles are represented by their outlines."
LineGraph1::usage =
"LineGraph1[list] converts a list of triangles to an object of type
Graphics in which tiles are represented by their outlines and
displayed with markings."
ColorGraph::usage =
"ColorGraph[list] converts a list of triangles to an object of type
Graphics in which tiles are represented by colored polygons."
AcuteTriangle::usage =
"AcuteTriangle is the baseline acute triangle."
ObtuseTriangle::usage =
"ObtuseTriangle is the baseline obtuse triangle."
a::usage =
"a[x,y,z] represents an acute isoceles triangle."
o::usage =
"o[x,y,z] represents an obtuse isoceles triangle."
Kite::usage =
"Kite is a sample kite tile."
Dart::usage =
"Dart is a sample dart tile."
Sun::usage =
"Sun is the sun pattern of five kite tiles meeting at a
vertex."
Star::usage =
"Star is the star pattern of five dart tiles meeting at a
vertex."
Options[ColorGraph] = {KiteColor->RGBColor[0.2,0.2,1.],
DartColor->RGBColor[0.7,0.7,1.]}
KiteColor::usage
"KiteColor is an option for ColorGraph indicating the color of
the acute triangles which form kite tiles."
DartColor::usage
"DartColor is an option for ColorGraph indicating the color of
the obtuse triangles which form dart tiles."
Begin["`Private`"]
(*
Both Penrose tiles will be considered to be a union of two
triangles. A kite will be represented by two acute triangles, and the
dart by two obtuse triangles.
Internally, we will represent these triangles by a[x,y,z] or
o[x,y,z] where x,y, and z are ordered pairs of real numbers.
Both kinds of triangles are isoceles with angles 72, 72, 36 and 36,
36, 108 degrees respectively.
The deflation operator takes each acute triangle to two acute
triangles and an obtuse. Obtuse triangles are taken to one triangle
of each type. The triangles are not the tiles themselves but each
forms half of a tile (two acutes make a kite and two obtuses make a
dart).
The tile shapes are recovered by drawing two of the sides of each
triangle (thus technically a[x,y,z] and o[x,y,z] represent
oriented triangles).
*)
C1=N[GoldenRatio-1]
C2=N[2-GoldenRatio] (* note C2 = (1-C1) *)
(* The deflation operator. *)
Deflate[a[x_, y_, z_]] :=
With[{d = (C1 x + C2 y),
e = (C1 y + C2 z)},
{a[d, z, x],
a[d, z, e],
o[y, e, d]}]
Deflate[o[x_, y_, z_]] :=
With[{d = C2 x + C1 z},
{o[z, d, y],
a[y, x, d]}]
Deflate[x_List] := Apply[Join,Deflate /@ x]
Deflate[x_, n_] := Nest[Deflate, x, n]
(* Display routines *)
LineGraph[t_] := Show[Graphics[t /.
{a[x_, y_, z_] -> Line[{y, z, x}],
o[x_, y_, z_] -> Line[{y, z, x}]}],
AspectRatio->Automatic]
(* Display routine with markings *)
LineGraph1[t_] := Show[Graphics[t /.
{a[x_, y_, z_] :> agraph[x,y,z],
o[x_, y_, z_] :> ograph[x,y,z]}],
AspectRatio->Automatic]
agraph[x_,y_,z_] :=With[{r=
N[Apply[Plus,(x-z)^2]^(1/2)]},
{Line[{y, z, x}],
{RGBColor[1,0,0],
Thickness[.005],
Circle[x,r N[1/GoldenRatio],
angles[{x,z},{x,y}]]},
{RGBColor[0,0,1],
Thickness[.005],
Circle[y,r,angles[{y,x},{y,z}]
]}}]
ograph[x_,y_,z_] := With[{r=
N[Apply[Plus,(x-z)^2]^(1/2)]},
{Line[{y, z, x}],{RGBColor[1,0,0],
Thickness[.005],
Circle[y,r N[1/GoldenRatio^3],
angles[{y,z},{y,x}]]},
{RGBColor[0,0,1],
Thickness[.005],
Circle[x,r N[1/GoldenRatio^2],
angles[{x,y},{x,z}]]}}]
angles[{a_,b_},{c_,d_}] :=
With[{v1=b-a,v2=d-c},
shortway[ ArcTan @@ v1,
ArcTan @@ v2]]
shortway[theta1_,theta2_]:=With[{t2=
Max[N[theta1],N[theta2]],
t1=Min[N[theta1],N[theta2]]},
If[Abs[N[(t2-t1)]] {{KiteColor, Polygon[{y, z, x}]},
Line[{y, z, x}]},
o[x_, y_, z_] -> {{ DartColor, Polygon[{y, z, x}]},
Line[{y, z, x}]}}] /. {opts} /. Options[ColorGraph],
AspectRatio->Automatic]
(* Some legal patterns follow. We have to start somewhere. *)
AcuteTriangle = a[{0,0},{GoldenRatio Cos[72 Degree],
GoldenRatio Sin[72 Degree]},{1,0}] // N
ObtuseTriangle = o[{1,0},{C1 Cos[36 Degree],C1 Sin[36
Degree]},{0,0}] // N
Sun=Module[{i},
Flatten[Table[
{a[{Cos[72 i Degree],Sin[72 i Degree]},
{0,0},{Cos[(36 + 72 i) Degree],
Sin[(36 +72 i) Degree]}],
a[{Cos[72 i Degree],Sin[72 i Degree]},
{0,0},{Cos[(-36 +72 i) Degree],
Sin[(-36 + 72 i) Degree]}]},
{i,0,4}]] // N]
Kite=Sun[[{1,2}]]
Star=Module[{i},
Flatten[Table[
{o[{0,0},
{Cos[72 i Degree],Sin[72 i Degree]},
GoldenRatio {Cos[(36 + 72 i) Degree],
Sin[(36 +72 i) Degree]}],
o[{0,0},
{Cos[72 i Degree],Sin[72 i Degree]},
GoldenRatio {Cos[(-36 + 72 i) Degree],
Sin[(-36 +72 i) Degree]}]},
{i,0,4}]] // N]
Dart=Star[[{1,2}]]
End[]
EndPackage[]