Rでペンローズタイルを描く
この記事は R Advent Calendar 2014 の25日目の記事です。
ペンローズ・タイルって皆様ご存知でしょうか。
ペンローズ・タイル - Wikipedia
簡単にまとめると以下のような特徴を持つ不思議なタイルとその平面充填方法です。
- 非周期的であり、同じ充填方法が現れない。
- kiteとdirtと呼ばれる二つの四角形から構成される。
- それぞれの四角形は同じ形のロビンソンの三角形という二等辺三角形を2つ組み合わせたもので出来ている。
- 三角形の長辺との長さは黄金比になっている。
- 再帰的に分割することができ、フラクタル図形の一種と言える。
このペンローズタイルと同じ性質を持つ図形はイスラム建築の模様や、電動シェーバーの網刃、準結晶等様々なところに見られます。
とっても不思議な図形ですね。まとまった解説記事がないのが残念です。
ということで、このペンローズタイルをRで描いてみました。せっかくなのでクリスマスツリー状にしています。
PHI<<-(1+sqrt(5))/2 L<<-2 decompose_kite<-function(t1,k,rev=FALSE){ if(rev){ x1<-c((t1$coord$x[2]/PHI+t1$coord$x[1])/PHI,t1$coord$x[3],t1$coord$x[1]) y1<-c((t1$coord$y[2]/PHI+t1$coord$y[1])/PHI,t1$coord$y[3],t1$coord$y[1]) x2<-c((t1$coord$x[2]/PHI+t1$coord$x[1])/PHI,t1$coord$x[3],(t1$coord$x[2]+t1$coord$x[3]/PHI)/PHI) y2<-c((t1$coord$y[2]/PHI+t1$coord$y[1])/PHI,t1$coord$y[3],(t1$coord$y[2]+t1$coord$y[3]/PHI)/PHI) x3<-c(t1$coord$x[2],(t1$coord$x[2]+t1$coord$x[3]/PHI)/PHI,(t1$coord$x[2]/PHI+t1$coord$x[1])/PHI) y3<-c(t1$coord$y[2],(t1$coord$y[2]+t1$coord$y[3]/PHI)/PHI,(t1$coord$y[2]/PHI+t1$coord$y[1])/PHI) }else{ x1<-c(t1$coord$x[3],t1$coord$x[1],(t1$coord$x[2]/PHI+t1$coord$x[3])/PHI) y1<-c(t1$coord$y[3],t1$coord$y[1],(t1$coord$y[2]/PHI+t1$coord$y[3])/PHI) x2<-c((t1$coord$x[2]/PHI+t1$coord$x[3])/PHI,t1$coord$x[1],(t1$coord$x[2]+t1$coord$x[1]/PHI)/PHI) y2<-c((t1$coord$y[2]/PHI+t1$coord$y[3])/PHI,t1$coord$y[1],(t1$coord$y[2]+t1$coord$y[1]/PHI)/PHI) x3<-c(t1$coord$x[2],(t1$coord$x[2]+t1$coord$x[1]/PHI)/PHI,(t1$coord$x[2]/PHI+t1$coord$x[3])/PHI) y3<-c(t1$coord$y[2],(t1$coord$y[2]+t1$coord$y[1]/PHI)/PHI,(t1$coord$y[2]/PHI+t1$coord$y[3])/PHI) } small_coord <-list(x=x1,y=y1) small_coord2<-list(x=x2,y=y2) big_coord <-list(x=x3,y=y3) polygon(small_coord$x, small_coord$y, col = "green") polygon(small_coord2$x, small_coord2$y, col = "green") polygon(big_coord$x, big_coord$y, col = "red") polygon(-small_coord$x, small_coord$y, col = "green") polygon(-small_coord2$x, small_coord2$y, col = "green") polygon(-big_coord$x, big_coord$y, col = "red") if(k<L && rev==FALSE){ decompose_dart( list(coord=big_coord), k=k+1, rev) decompose_kite(list(coord=small_coord), k=k+1,!rev) decompose_kite(list(coord=small_coord2), k=k+1, rev) } if(k<L && rev==TRUE){ decompose_dart( list(coord=big_coord), k=k+1,rev) decompose_kite(list(coord=small_coord), k=k+1,rev) decompose_kite(list(coord=small_coord2), k=k+1,rev) } return(list(small=list(coord=small_coord), big=list(coord=big_coord))) } plot_Tri_kite<-function(a,b,r,theta,rev=FALSE){ x<-c(0,-1*cos(pi*3/5),-2*cos(pi*3/5)) y<-c(0,sin(pi*3/5),0) x1<-(r*x*cos(theta)-r*y*sin(theta))+a y1<-(r*x*sin(theta)+r*y*cos(theta))+b coord<-list(x=x1,y=y1) decompose_kite(list(coord=coord),1,rev) return(list(coord=coord)) } decompose_dart<-function(t1,k,rev=FALSE){ if(rev){ x1<-c((t1$coord$x[3]+t1$coord$x[1]/PHI)/PHI,t1$coord$x[1],t1$coord$x[2]) y1<-c((t1$coord$y[3]+t1$coord$y[1]/PHI)/PHI,t1$coord$y[1],t1$coord$y[2]) x2<-c(t1$coord$x[3],(t1$coord$x[3]+t1$coord$x[1]/PHI)/PHI,t1$coord$x[2]) y2<-c(t1$coord$y[3],(t1$coord$y[3]+t1$coord$y[1]/PHI)/PHI,t1$coord$y[2]) }else{ x1<-c(t1$coord$x[2],t1$coord$x[3],(t1$coord$x[3]/PHI+t1$coord$x[1])/PHI) y1<-c(t1$coord$y[2],t1$coord$y[3],(t1$coord$y[3]/PHI+t1$coord$y[1])/PHI) x2<-c(t1$coord$x[2],(t1$coord$x[3]/PHI+t1$coord$x[1])/PHI,t1$coord$x[1]) y2<-c(t1$coord$y[2],(t1$coord$y[3]/PHI+t1$coord$y[1])/PHI,t1$coord$y[1]) } small_coord<-list(x=x1,y=y1) big_coord<-list(x=x2,y=y2) polygon(small_coord$x, small_coord$y, col = "green") polygon(big_coord$x, big_coord$y, col = "red") polygon(-small_coord$x, small_coord$y, col = "green") polygon(-big_coord$x, big_coord$y, col = "red") if(k<L){ decompose_dart(list(coord=big_coord), k=k+1) decompose_kite(list(coord=small_coord), k=k+1) } return(list(small=list(coord=small_coord), big=list(coord=big_coord))) } plot(0,0, xlim=c(-10,10), ylim=c(-10,10)) t1<-plot_Tri_dart(0,0,5,0) plot_Tri_dart<-function(a,b,r,theta,rev=FALSE){ x<-c(0,cos(pi*1/5),2*cos(pi*1/5)) y<-c(0,sin(pi*1/5),0) x1<-(r*x*cos(theta)-r*y*sin(theta))+a y1<-(r*x*sin(theta)+r*y*cos(theta))+b if(rev){coord<-list(x=x1[3:1],y=y1[3:1])} else{coord<-list(x=x1,y=y1)} decompose_dart(list(coord=coord),1) return(list(coord=coord)) } plot(0,0, xlim=c(-5,5), ylim=c(-1,9)) t1<-plot_Tri_kite(0,0,1,pi/10) t1<-plot_Tri_dart(t1$coord$x[2],t1$coord$y[2],1/PHI,-3*pi/10) t2<-t1 t1<-plot_Tri_kite(t1$coord$x[2],t1$coord$y[2],1,-5*pi/10) t2<-plot_Tri_kite(t2$coord$x[1],t2$coord$y[1]+1/PHI,1,-5*pi/10) t3<-t2 t2<-plot_Tri_dart(t2$coord$x[2],t2$coord$y[2],1/PHI,-9*pi/10) t2<-plot_Tri_kite(t2$coord$x[1],t2$coord$y[1],1,-7*pi/10) t3<-plot_Tri_dart(t3$coord$x[1],t3$coord$y[1]+1,1/PHI,-5*pi/10) t4<-t3 t3<-plot_Tri_kite(t3$coord$x[2],t3$coord$y[2],1,-7*pi/10) t3<-plot_Tri_dart(t3$coord$x[1],t3$coord$y[1],1/PHI,-3*pi/10) t3<-plot_Tri_dart(t3$coord$x[2]+cos(3*pi/10)/PHI,t3$coord$y[2]+sin(3*pi/10)/PHI,1/PHI,-9*pi/10) t4<-plot_Tri_dart(t4$coord$x[1],t4$coord$y[1],1/PHI,-1*pi/10) t5<-t4 t4<-plot_Tri_dart(t4$coord$x[3],t4$coord$y[3],1/PHI,5*pi/10) t4<-plot_Tri_dart(t4$coord$x[1],t4$coord$y[1],1/PHI,9*pi/10) t5<-plot_Tri_kite(t5$coord$x[1],t5$coord$y[1],1,pi/10) t5<-plot_Tri_kite(t5$coord$x[3],t5$coord$y[3],1,3*pi/10) t5<-plot_Tri_dart(t5$coord$x[2],t5$coord$y[2],1/PHI,-1*pi/10) t6<-t5 t5<-plot_Tri_dart(t5$coord$x[3],t5$coord$y[3],1/PHI,5*pi/10) t5<-plot_Tri_kite(t5$coord$x[1],t5$coord$y[1],1,pi/10) t5<-plot_Tri_kite(t5$coord$x[3],t5$coord$y[3],1,3*pi/10) t5<-t6 t5<-plot_Tri_kite(t5$coord$x[1],t5$coord$y[1],1,pi/10) t5<-plot_Tri_kite(t5$coord$x[3],t5$coord$y[3],1,3*pi/10) t5<-plot_Tri_dart(t5$coord$x[2],t5$coord$y[2],1/PHI,-1*pi/10) t6<-t5 t5<-plot_Tri_dart(t5$coord$x[3],t5$coord$y[3],1/PHI,5*pi/10) t5<-plot_Tri_kite(t5$coord$x[1],t5$coord$y[1],1,pi/10) t5<-plot_Tri_kite(t5$coord$x[3],t5$coord$y[3],1,3*pi/10) t6<-plot_Tri_kite(t6$coord$x[1],t6$coord$y[1],1,pi/10) t6<-plot_Tri_kite(t6$coord$x[3],t6$coord$y[3],1,3*pi/10) t6<-plot_Tri_dart(t6$coord$x[2],t6$coord$y[2],1/PHI,-1*pi/10) t6<-plot_Tri_dart(t6$coord$x[1],t6$coord$y[1],1/PHI,3*pi/10) t7<-plot_Tri_dart(t6$coord$x[3],t6$coord$y[3],1/PHI,-7*pi/10) t6<-plot_Tri_kite(t6$coord$x[2],t6$coord$y[2],1,pi/10)
実行結果が以下の通り、
ところどころロビンソンの三角形がむき出しになっていますね。。。
失敗したようなので来年の宿題としてリベンジしたいところです。