Wolfram Cloud Document

We produce a visualization of the Penrose Tiling which runs in a single Manipulate for dynamic interactivity. The body of the Manipulate contains all the code for generating the plots and runs reliably on the cloud.

Penrose Tiling

In[]:=

Manipulate[Module[{gridShifts,range,gridCount,gridVectors,tileTypeGridIndices,tileTypeCount,tileTypeGridVectors,tileTypeAreas,tileTypeColors,gridLineNumbers,tileTypeGraphics,gridIndices,gridLineIntersectionPoints,tileCornerLatticeCoordinates,tileCornerVertices,gridVector1,gridVector2,tileVertices},gridShifts={γ1,γ2,γ3,γ4,γ5};gridShifts=gridShifts;(*preservetilingclass*)gridShifts=5(gridShifts-Mean[gridShifts])+tilingClass;range=tileRange;gridCount=Length[gridShifts];gridVectors=CirclePoints[gridCount];gridVectors=gridVectors//N;tileTypeGridIndices=Subsets[Range[gridCount],{2}];tileTypeGridIndices=Select[tileTypeGridIndices,Function[Unequal[Chop[Det[N[gridVectors[[#]]]]],0]]];tileTypeCount=Length[tileTypeGridIndices];tileTypeGridVectors=gridVectors[[#]]&/@tileTypeGridIndices;tileTypeAreas=Abs[Map[Det,tileTypeGridVectors]];tileTypeColors=Map[Function[Blend[{tileColor1,tileColor2},#]],Rescale[Round[tileTypeAreas,10.^-10]]];gridLineNumbers=Table[Range[-range,range],gridCount];tileTypeGraphics=Table[gridIndices=tileTypeGridIndices[[tileTypeIndex]];gridLineIntersectionPoints=Dot[Transpose[Transpose[Tuples[gridLineNumbers[[gridIndices]]]]-gridShifts[[gridIndices]]],Transpose[Inverse[gridVectors[[gridIndices]]]]];tileCornerLatticeCoordinates=Transpose[Ceiling[Dot[gridVectors,Transpose[gridLineIntersectionPoints]]+gridShifts]];tileCornerLatticeCoordinates[[All,gridIndices]]=Tuples[gridLineNumbers[[gridIndices]]];tileCornerVertices=Dot[Transpose[Transpose[tileCornerLatticeCoordinates]-gridShifts],gridVectors];{gridVector1,gridVector2}=gridVectors[[gridIndices]];tileVertices=Transpose[{tileCornerVertices,(tileCornerVertices+gridVector1),(tileCornerVertices+gridVector1+gridVector2),(tileCornerVertices+gridVector2)}];{FaceForm[tileTypeColors[[tileTypeIndex]]],Polygon[tileVertices]},{tileTypeIndex,tileTypeCount}];Graphics[{EdgeForm[Opacity[edgeOpacity]],tileTypeGraphics},PlotRange->plotRange,ImageSize->400]],{{tilingClass,0.2},0,1},{{γ1,0.0},0,1},{{γ2,0.0},0,1},{{γ3,0.0},0,1},{{γ4,0.0},0,1},{{γ5,0.0},0,1},{{edgeOpacity,.2},0,1},{tileColor1,GrayLevel[.5]},{tileColor2,GrayLevel[.9]},{{tileRange,5},1,30,1},{{plotRange,10},5,30},ControlPlacement->Top,SaveDefinitions->False]

Out[]=