Quaquaversal Tiling

Author

Eric W. Weisstein
August 27, 2026

This notebook downloaded from https://mathworld.wolfram.com/notebooks/Tilings/QuaquaversalTiling.nb.

For more information, see Eric's MathWorld entry https://mathworld.wolfram.com/QuaquaversalTiling.html.

©2026 Wolfram Research, Inc. except for portions noted otherwise

Reference

J. H. Conway and C. Radin, Quaquaversal Tilings and Rotations, Inventiones Mathematicae 132, 179-188 (1998).

Substitution

QuaquaversalPrismSubdivision[level_Integer:1]/;NonNegative[level]:=Module[{b,m,p,q,t,prism,pieces,rotateX,rotateZ,flip,children,vertices,faces,affineMap,applyMap,childMaps,tileMaps,tilePrisms},b={{0,0},{(Sqrt[3]),0},{(Sqrt[3]),1}};{m,p,q}={(1/2) (b[[1]]+b[[3]]),(1/2) (b[[1]]+b[[2]]),(1/2) (b[[2]]+b[[3]])};t={{b[[1]],p,m},{b[[2]],p,m},{m,q,b[[2]]},{m,q,b[[3]]}};prism[s_]:=Join[(Append[#1,0]&)/@s,(Append[#1,(1/2)]&)/@s];pieces=prism/@t;rotateX=RotationTransform[(π/2),{1,0,0},{0,(1/4),(1/4)}];rotateZ=RotationTransform[((2 π)/3),{0,0,1},Append[Mean[{m,b[[2]],b[[3]]}],0]];flip={#1[[1]],#1[[2]],1-#1[[3]]}&;children={pieces[[1]],rotateX/@pieces[[2]],rotateX/@pieces[[3]],pieces[[4]],flip/@pieces[[1]],flip/@pieces[[2]],flip/@rotateZ/@pieces[[3]],flip/@rotateZ/@pieces[[4]]};vertices=Join[(Append[#1,0]&)/@b,(Append[#1,1]&)/@b];faces={{1,2,3},{4,6,5},{1,4,5,2},{2,5,6,3},{3,6,4,1}};affineMap[target_]:=Module[{a,sourceMatrix},sourceMatrix=Function[point,Append[point,1]]/@vertices[[{1,2,3,4}]];a=(Transpose[(Function[coordinate,LinearSolve[sourceMatrix,coordinate]]/@(Transpose[target[[{1,2,3,4}]]]))]);MapThread[Append,{a,{0,0,0,1}}]];applyMap[x_,a_]:=Most[Append[x,1].a];childMaps=affineMap/@children;tileMaps=Nest[Flatten[Table[child.parent,{parent,#1},{child,childMaps}],1]&,{IdentityMatrix[4]},level];tilePrisms=Table[(applyMap[#1,transform]&)/@vertices,{transform,tileMaps}];Graphics3D[MapIndexed[{Directive[ColorData[97][Mod[First[#2]-1,8]+1],Opacity[0.65]],EdgeForm[LightDarkSwitched[Black,White]],GraphicsComplex[#1,Polygon[faces]]}&,tilePrisms],Boxed->False,Lighting->"Neutral"]]

GraphicsRow[(Labeled[QuaquaversalPrismSubdivision[#1],Style["level "<>ToString[#1],16,FontFamily->"Times"],Top,{}]&)/@{1,3}]