## Penrose Tiling

Keith Vetter 2015-12-01 -- Penrose Tiling is a non-periodic tiling generated by an aperiodic set of prototiles. Penrose tilings are named after mathematician and physicist Roger Penrose, who investigated these sets in the 1970s.

Shown here is a Penrose tiling of type P3 constructed using deflation. The P3 uses a pair of rhombuses with equal sides but different angles plus a set of rules of how they may be assembled.

Deflation is a construction technique where existing rhombuses are divided into two or three smaller rhombuses. In this instance we start with a circle divided into 10 half-rhombus triangles. The next generation divides each triangle into smaller triangles. By careful orientation and drawing the border of only two sides of each triangle we construct a Penrose tiling.

```##+##########################################################################
#
# Penrose.tcl -- Draws a Penrose P3 tiling using deflation of the Robinson triangles
# by Keith Vetter 2015-11-25
# Based on http://preshing.com/20110831/penrose-tiling-explained/

package require Tk
package require img::window
package require tooltip

lappend auto_path ~/misc/tcl_packages
catch {package require trampoline}

set S(sz) 700
set S(generation) [expr {2 + int(rand() * 4)}]
set S(max,generation) 10
set S(save,file) penrose.svg
set S(colors,0) #2212FF
set S(colors,1) #7575FF

array set CLR {
steps 100
delay 20
big,delay 2500
go 0
}

##+##########################################################################
#
# Generation0 -- produce the initial Penrose tiling
#
proc Generation0 {} {
global S TRI
set pi [expr {acos(-1)}]

set TRI(0) {}
set type "0"
set A {0 0}
set radius [expr {\$S(sz) / 2}]
for {set i 0} {\$i < 10} {incr i} {
set theta [expr {\$i * 2 * \$pi / 10}]
set theta [expr {(\$i + 1) * 2 * \$pi / 10}]

if {\$i & 1} {
lappend TRI(0) [list \$type \$A \$B \$C]
} else {
lappend TRI(0) [list \$type \$A \$C \$B]
}
}
}
##+##########################################################################
#
# SubDivideThisGeneration -- creates the next generation of Penrose tiling
#
proc SubDivideThisGeneration {current_generation} {
global TRI
set next_generation [expr {\$current_generation + 1}]
if {[info exists TRI(\$next_generation)]} return

set phi [expr { 1 / ((1 + sqrt(5)) / 2)}]
set new_triangles {}
foreach triangle \$TRI(\$current_generation) {
lassign \$triangle type A B C
if {\$type == 0} {
lappend new_triangles [list 1 \$P \$C \$A] [list 0 \$C \$P \$B]
} else {
lappend new_triangles [list 1 \$R \$C \$A] [list 1 \$Q \$R \$B] [list 0 \$R \$Q \$A]
}
}
set TRI(\$next_generation) \$new_triangles
return
}
##+########################################################################## #
# DrawThisGeneration -- draws all the Robinson triangles for this generation
#
proc DrawThisGeneration {generation} {
set ::S(generation) \$generation
.generations config -text "Generation \$generation"

.c delete all
set width 5
if {\$generation > 3} {set width 3}
if {\$generation > 5} {set width 2}
if {\$generation > 7} {set width 1}
foreach triangle \$::TRI(\$generation) {
lassign \$triangle type A B C
.c create polygon {*}\$B {*}\$A {*}\$C -fill \$::S(colors,\$type) \
-tag [list poly "poly_\$type"] -width 1 -outline \$::S(colors,\$type)
.c create line {*}\$B {*}\$A {*}\$C -fill black -width \$width -tag border
}
SizeToWindow
}
##+##########################################################################
#
# NewGeneration -- changes to a new generation of the tiling.
#
proc NewGeneration {generation} {
global TRI
if {\$generation eq "+"} {
set generation [expr {\$::S(generation) + 1}]
} elseif {\$generation eq "-"} {
set generation [expr {\$::S(generation) - 1}]
}
set generation [expr {max(0, min(\$generation, \$::S(max,generation)))}]
if {! [info exists TRI(\$generation)]} {
for {set i 0} {\$i < \$generation} {incr i} {
SubDivideThisGeneration \$i
}
}
DrawThisGeneration \$generation
}
################################################################
#
# GUI stuff below
#
#
proc DoDisplay {} {
destroy {*}[winfo child .]
wm title . "Penrose Tiling"

frame .ctrl -bd 2 -relief solid

canvas .c -width \$::S(sz) -height \$::S(sz) -bd 0 -highlightthickness 0 -bg cyan
bind .c <Configure> {
set h [expr {%h / 2.0}] ; set w [expr {%w / 2.0}] ;
%W config -scrollregion [list -\$w -\$h \$w \$h] ;
SizeToWindow
}
grid .c -row 0 -column 0 -sticky news
grid columnconfigure . 0 -weight 1
grid rowconfigure . 0 -weight 1

# Generations dialog
::ttk::frame .f_generations -borderwidth 2 -relief ridge
::ttk::label .generations -text "Generation \$::S(generation)" -foreground blue
button .prev -image ::bit::left -command {NewGeneration -}
tooltip::tooltip .prev "Previous generation"
button .next -image ::bit::right -command {NewGeneration +}
tooltip::tooltip .next "Next generation"
button .zoomin -image ::bit::up -command {Zoom 1.1}
tooltip::tooltip .zoomin "Zoom in"
bind .zoomin <3> {Zoom 2}
button .zoomout -image ::bit::down -command {Zoom .9}
tooltip::tooltip .zoomout "Zoom out"
bind .zoomout <3> {Zoom .5}
grid x .generations - - -in .f_generations
grid x x .zoomin x -in .f_generations
grid x .prev x .next -in .f_generations
grid x x .zoomout -in .f_generations
grid columnconfigure .f_generations {0 99} -weight 1
place .f_generations -in .c -relx 1 -x -10 -y 10 -anchor ne

button .hideorshow -image ::bit::right -command HideOrShowCtrlPanel \
-bd 2 -relief ridge -highlightthickness 0 -padx 1m
tooltip::tooltip .hideorshow "Show or hide\nconfiguration panel"
place .hideorshow -in .c -relx 1 -rely 1 -x -2 -y -2 -anchor se

# Control panel
label .ctrl.title -text "Penrose Tiling\nConfiguration"
.ctrl.title config -font "[font actual [.ctrl.title cget -font]] -weight bold"

# Colors dialog
set CP .ctrl.colors
::ttk::labelframe \$CP -text Colors -padding {0 0 0 .1i}
::ttk::label \$CP.t_rhomb -text "t rhomb "
label \$CP.t_rhomb_value -textvariable ::S(colors,0) \
-relief sunken -bg white -width 10
button \$CP.t_pick -image ::bit::star -command {PickColor 0}
tooltip::tooltip \$CP.t_pick "Pick color for t rhombus"
::ttk::label \$CP.tt_rhomb -text "T rhomb "
label \$CP.tt_rhomb_value -textvariable ::S(colors,1) \
-relief sunken -bg white
button \$CP.tt_pick -image ::bit::star -command {PickColor 1}
tooltip::tooltip \$CP.tt_pick "Pick color for T rhombus"
grid \$CP.t_rhomb \$CP.t_rhomb_value \$CP.t_pick -sticky ew
grid \$CP.tt_rhomb \$CP.tt_rhomb_value \$CP.tt_pick -sticky ew

foreach w {random white reset} \
tip {"Random colors" "Black and white coloring" "Reset coloring"} {
::ttk::button \$CP.\$w -text [string totitle \$w] \
-command [list ChangeColoring \$w]
tooltip::tooltip \$CP.\$w \$tip
grid \$CP.\$w - - -pady {1m 0}
}
::ttk::checkbutton \$CP.animate -text "Animate" \
-variable ::CLR(go) -command RotateColors
grid \$CP.animate - - -pady {5m 0}

# Save dialog
set SF .ctrl.f_save
::ttk::labelframe \$SF -text Save -padding {0 0 0 .1i}
::ttk::button \$SF.fillscreen -text "Fill window" -command FullPage
tooltip::tooltip \$SF.fillscreen "Expand tiling to\nfill the window"
::ttk::button \$SF.8_5x11 -text "8\xbd x 11" -command 8_5x11
tooltip::tooltip \$SF.8_5x11 "Resize window to\n8\xbd x 11 ratio"
::ttk::button \$SF.border -text "Border" -command Border
tooltip::tooltip \$SF.border "Draw border around tiling"
::ttk::button \$SF.save -text "Save" -command DoSave
tooltip::tooltip \$SF.save "Save tiling"
pack \$SF.fillscreen \$SF.8_5x11 \$SF.border \
-side top -expand 1 -pady {1m 0}
pack \$SF.save -side left -expand 1 -pady {4m 0}

grid rowconfigure .ctrl 100 -weight 1
}

proc HideOrShowCtrlPanel {} {
if {[winfo ismapped .ctrl]} {
grid forget .ctrl
.hideorshow config -image ::bit::right
} else {
grid .ctrl -row 0 -column 1 -sticky ns
.hideorshow config -image ::bit::left
}
}

proc ChangeColoring {{how random}} {
if {\$how eq "reset"} {
set ::S(colors,0) #2212FF
set ::S(colors,1) #7575FF
.c config -bg cyan
} elseif {\$how eq "white"} {
set ::S(colors,0) white
set ::S(colors,1) white
.c config -bg white
} else {
set ::S(colors,0) [format "\#%02x%02x%02x" \
[expr {int (255 * rand())}] \
[expr {int (255 * rand())}] \
[expr {int (255 * rand())}]]
set ::S(colors,1) [format "\#%02x%02x%02x" \
[expr {int (255 * rand())}] \
[expr {int (255 * rand())}] \
[expr {int (255 * rand())}]]
}
.c itemconfig poly_0 -fill \$::S(colors,0) -outline \$::S(colors,0)
.c itemconfig poly_1 -fill \$::S(colors,1) -outline \$::S(colors,1)
}
proc PickColor {who} {
set new_clr [tk_chooseColor -initialcolor \$::S(colors,\$who)]
if {\$new_clr ne ""} {
set ::S(colors,\$who) \$new_clr
.c itemconfig poly_0 -fill \$::S(colors,0) -outline \$::S(colors,0)
.c itemconfig poly_1 -fill \$::S(colors,1) -outline \$::S(colors,1)
}
}
##+##########################################################################
#
#
proc VAdd {v1 v2 {scaling 1}} {
foreach {x1 y1} \$v1 {x2 y2} \$v2 break
return [list [expr {\$x1 + \$scaling*\$x2}] [expr {\$y1 + \$scaling*\$y2}]]
}
##+##########################################################################
#
# SizeToWindow -- scales tiling to fit snugly in the canvas window.
#
proc SizeToWindow {} {
.c delete boundary
lassign [.c bbox all] x0 y0 x1 y1
if {\$x0 eq ""} return
set actual_width [expr {\$x1 - \$x0}]
set actual_height [expr {\$y1 - \$y0}]

set canvas_width [winfo width .c]
set canvas_height [winfo height .c]
if {\$canvas_width < 10} return

set scale_width [expr {\$canvas_width / double(\$actual_width)}]
set scale_height [expr {\$canvas_height / double(\$actual_height)}]
set scale_factor [expr {min(\$scale_width, \$scale_height)}]
.c scale all 0 0 \$scale_factor \$scale_factor
}

proc Zoom {factor} {
.c delete boundary
.c scale all 0 0 \$factor \$factor
}
image create bitmap ::bit::left -data {
#define left_width 11
#define left_height 11
static char left_bits = {
0x00, 0x00, 0x20, 0x00, 0x30, 0x00, 0x38, 0x00, 0xfc, 0x01, 0xfe,
0x01, 0xfc, 0x01, 0x38, 0x00, 0x30, 0x00, 0x20, 0x00, 0x00, 0x00
}
}
image create bitmap ::bit::right -data {
#define right_width 11
#define right_height 11
static char right_bits = {
0x00, 0x00, 0x20, 0x00, 0x60, 0x00, 0xe0, 0x00, 0xfc, 0x01, 0xfc,
0x03, 0xfc, 0x01, 0xe0, 0x00, 0x60, 0x00, 0x20, 0x00, 0x00, 0x00
}
}
image create bitmap ::bit::up -data {
#define up_width 11
#define up_height 11
static char up_bits = {
0x00, 0x00, 0x20, 0x00, 0x70, 0x00, 0xf8, 0x00, 0xfc, 0x01, 0xfe,
0x03, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x00, 0x00, 0x00, 0x00
}
}
image create bitmap ::bit::down -data {
#define down_width 11
#define down_height 11
static char down_bits = {
0x00, 0x00, 0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0xfe,
0x03, 0xfc, 0x01, 0xf8, 0x00, 0x70, 0x00, 0x20, 0x00, 0x00, 0x00
}
}
image create bitmap ::bit::star -data {
#define plus_width 11
#define plus_height 11
static char plus_bits = {
0x00, 0x00, 0x22, 0x02, 0x24, 0x01, 0xa8, 0x00, 0x70, 0x00, 0xfe,
0x03, 0x70, 0x00, 0xa8, 0x00, 0x24, 0x01, 0x22, 0x02, 0x00, 0x00
}
}
set txt "Penrose Tiling\nby Keith Vetter\nNovember, 2015"
set detail  "A Penrose tiling is a non-periodic tiling generated by "
append detail "an aperiodic set of prototiles. Penrose tilings are "
append detail "named after mathematician and physicist Roger Penrose, "
append detail "who investigated these sets in the 1970s."
append detail "\n\n"
append detail "Shown here is a Penrose tiling of type P3 constructed using "
append detail "deflation. The P3 uses a pair of rhombuses with equal sides "
append detail "but different angles plus a set of rules of how they may be "
append detail "assembled. "
append detail "\n\n"
append detail "Deflation is a construction technique where existing "
append detail "rhombuses are divided into two or three smaller rhombuses. "
append detail "In this instance we start with a circle divided into 10 "
append detail "half-rhombus triangles. The next generation divides each "
append detail "triangle into smaller triangles. By careful orientation and "
append detail "drawing the border of only two sides of each triangle we "
append detail "construct a Penrose tiling."

tk_messageBox -icon info -message \$txt -detail \$detail \
-title "About Penrose Tiling" -parent .
}

proc 8_5x11 {} {
.c config -width 8.5i -height 11i
return

# Resize canvas to be in 8.5 x 11 ratio
# TODO: allow 11 x 8.5
set w [winfo width .c]
set h [winfo height .c]

set new_height [expr {round(\$w * 11 / 8.5)}]
set new_width [expr {round(\$h * 8.5 / 11)}]

if {\$new_height < \$h} {
.c config -height \$new_height
} elseif {\$new_width < \$w} {
.c config -width \$new_width
} else {
return
}
update
wm geom . [winfo reqwidth .]x[winfo reqheight .]
}
proc FullPage {} {
.c delete boundary

# Expands canvas content to fill the current canvas window
# Assumes 0,0 is center of window and content is circular
set c_width [expr {[winfo width .c] / 2.}]
set c_height [expr {[winfo height .c] / 2.}]
set c_diag [expr {hypot(\$c_width, \$c_height)}]
set c_diag [expr {\$c_diag + 10}]

lassign [.c bbox all] x0 y0 x1 y1
set r_width [expr {(\$x1 - \$x0) / 2.}]
set r_height [expr {(\$y1 - \$y0) / 2.}]

set scale_x [expr {\$c_diag / \$r_width}]
set scale_y [expr {\$c_diag / \$r_height}]
.c scale all 0 0 \$scale_y \$scale_y
}
proc Border {} {
.c delete boundary
set x [expr {[winfo width .c] / 2 + 1}]
set y [expr {[winfo height .c] / 2 + 1}]
.c create rect -\$x -\$y \$x \$y -tag boundary -width 10 -outline black -fill {}
}
proc DoSave {} {
set filetypes [list {Svg .svg} {Image .png}]
if {"trampoline" in [package names]} {
lappend filetypes [list Pdf .pdf]
}
set fname [tk_getSaveFile -filetypes \$filetypes \
-title "Save Penrose Tiling" \
-initialfile [file rootname \$::S(save,file)] \
-typevariable ::S(save,type)]
if {\$fname eq ""} return
set ::S(save,file) [string map [list [pwd]/ ""] \$fname]

set ext [string tolower [file extension \$::S(save,file)]]
if {\$ext eq ".svg"} {
SaveSvg
} elseif {\$ext eq ".pdf"} {
SavePdf
} else {
SavePng
}
tk_messageBox -icon info -message "Saved tiling as \$::S(save,file)" -parent .
}
proc SavePng {} {
# Canvas must be topmost with no placed slaves
foreach slave [place slaves .c] {
set PLACE(\$slave) [place info \$slave]
place forget \$slave
}
raise .
update
# Hack, sometimes the tk_getSaveFile dialogs weren't being deleted in time
after 50 ; update

if {"::img::pen" in [image names]} { image delete ::img::pen }
image create photo ::img::pen -data .c

foreach slave [array names PLACE] {
place \$slave {*}\$PLACE(\$slave)
}

::img::pen write \$::S(save,file) -format png
image delete ::img::pen
}
proc SavePdf {} {
set x_shift [expr {[winfo width .c] / 2}]
set y_shift [expr {[winfo height .c] / 2}]
.c move all \$x_shift \$y_shift
::pdf::generate .c \$::S(save,file)
.c move all -\$x_shift -\$y_shift
}
proc SaveSvg {} {
set fout [open \$::S(save,file) w]
puts \$fout [GenerateSvg]
close \$fout
}
proc GenerateSvg {} {
set xml "<?xml version='1.0'?>\n"
append xml "<!DOCTYPE svg PUBLIC '-//W3C//DTD SVG 1.1//EN' "
append xml "'Graphics/SVG/1.1/DTD/svg11.dtd'>\n"
set width [winfo width .c]
set height [winfo height .c]
append xml "<svg width='\$width' height='\$height' version='1.1' "
append xml "xmlns='http://www.w3.org/2000/svg' "

foreach id [.c find all] {
set line ""
if {[.c type \$id] eq "polygon"} {
set stroke [.c itemcget \$id -outline]
set fill [.c itemcget \$id -fill]

set line "  <polygon points='[GetTranslatedCoords \$id]' "
append line "style='stroke-width: 1; stroke-linejoin: round; "
append line "stroke: \$stroke; fill: \$fill'"
append line "/>"
} elseif {[.c type \$id] eq "line"} {
set stroke [.c itemcget \$id -fill]
set width [.c itemcget \$id -width]

set line "  <polyline points='[GetTranslatedCoords \$id]' "
append line "style='stroke-linejoin: round; fill: none; "
append line "stroke-width: \$width; stroke: \$stroke'"
append line "/>"
} elseif {[.c type \$id] eq "rectangle"} {
lassign [GetTranslatedCoords \$id] x0 y0 x1 y1
set w [expr {\$x1 - \$x0}]
set h [expr {\$y1 - \$y0}]
set stroke [.c itemcget \$id -outline]
set width [.c itemcget \$id -width]

set line "  <rect x='\$x0' y='\$y0' width='\$w' height='\$h' "
append line "style='fill: none; stroke: \$stroke; stroke-width: \$width'/>"
} else {
puts stderr "svg conversion error: unknown type: [.c type id]"
}
append xml \$line "\n"
}
append xml "</svg>\n"
return \$xml
}
##+##########################################################################
#
# GetTranslatedCoords -- shift coordinates so 0,0 is in the top left corner
#
proc GetTranslatedCoords {id} {
set x_shift [expr {[winfo width .c] / 2}]
set y_shift [expr {[winfo height .c] / 2}]

set xy {}
foreach {x y} [.c coords \$id] {
lappend xy [expr {round(\$x + \$x_shift)}] [expr {round(\$y + \$y_shift)}]
}
return \$xy
}
##+##########################################################################
#
# RotateColors -- animation to slowly fade the colors
#
proc RotateColors {} {
global CLR
foreach aid [after info] { after cancel \$aid }

if {! \$CLR(go)} return
foreach id {poly_0 poly_1} {
set clr [format "\#%02x%02x%02x" \
[expr {int (255 * rand())}] \
[expr {int (255 * rand())}] \
[expr {int (255 * rand())}]]
RotateColorForId \$id \$clr
}
after \$CLR(big,delay) RotateColors
}
proc RotateColorForId {id next_color} {
global CLR

set who ""
regexp {\d+} \$id who
set current [.c itemcget \$id -fill]
foreach var {red0 green0 blue0} value [winfo rgb . \$current] {
set \$var [expr {\$value/256}]
}
foreach var {red1 green1 blue1} value [winfo rgb . \$next_color] {
set \$var [expr {\$value/256}]
}
set dred [expr {\$red1 - \$red0}]
set dgreen [expr {\$green1 - \$green0}]
set dblue [expr {\$blue1 - \$blue0}]

# Generate after events for each step in the color fade
for {set i 0} {\$i < \$CLR(steps)} {incr i} {
set red [expr {int(\$red0 + \$dred/double(\$CLR(steps)) * \$i)}]
set green [expr {int(\$green0 + \$dgreen/double(\$CLR(steps)) * \$i)}]
set blue [expr {int(\$blue0 + \$dblue/double(\$CLR(steps)) * \$i)}]
set clr [format "\#%02x%02x%02x" \$red \$green \$blue]
after [expr {(\$i+1) * \$CLR(delay)}] \
".c itemconfig \$id -fill \$clr -outline \$clr ; set ::S(colors,\$who) \$clr"
}
}
################################################################
Generation0
DoDisplay
NewGeneration \$S(generation)
return```

ptile : MoMath's fixes/extensions to Stuart Levy's ptile project from the mid 1990s. Ptile lets the user interactively build a tiling, as a collection of patches, each comprising one or more polygonal tiles. The user can copy, paste and duplicate patches.

 Category Mathematics