PrograMing: pinwheel tiling
- To: mathgroup at smc.vnet.net
- Subject: [mg9543] PrograMing: pinwheel tiling
- From: "Xah" <xah at best.com>
- Date: Thu, 13 Nov 1997 01:40:07 -0500
- Organization: smtp.best.com
- Sender: owner-wri-mathgroup at wolfram.com
Here's a code for pinwheel tiling.
(*Pinwheel tiling*)
Clear[gp];
gp=NestList[(#/.triangle[{a_,b_,c_}]:>
Module[{w,x,y,z},w=(a+b)/2;x=(c-a)/5*2+a;y=(c-a)/5*4+a;
z=(b+y)/2;{triangle[{a,x,w}],triangle[{w,z,b}],
triangle[{b,y,c}],triangle[{w,z,y}],triangle[{y,x,w}]}])&,{
triangle[{{0,0},{2/Sqrt[5],0},{2/Sqrt[5],1/Sqrt[5]}}]},4];
gp=Transpose at {
Table[{Thickness[.0005+i/150],Hue[0,i,.8]},{i,0,1,1/(Length at gp-1)}],
Reverse at gp}/.pat:{_Thickness,_Hue}:>
Sequence@@pat/.triangle[{a_,rest__}]:>Line[{a,rest,a}];
Show[Graphics[{(N at gp)}],AspectRatio->Automatic];
(*Variations*)
(*Vertexes of Pinwheel tiling, idea borrowed from M. Senechal*)
Clear[gp];
gp=NestList[(#/.triangle[{a_,b_,c_}]:>
Module[{w,x,y,z},w=(a+b)/2;x=(c-a)/5*2+a;y=(c-a)/5*4+a;
z=(b+y)/2;{triangle[{a,x,w}],triangle[{w,z,b}],
triangle[{b,y,c}],triangle[{w,z,y}],triangle[{y,x,w}]}])&,{
triangle[{{0,0},{2/Sqrt[5],0},{2/Sqrt[5],1/Sqrt[5]}}],
triangle[{{2/Sqrt[5],1/Sqrt[5]},{0,1/Sqrt[5]},{0,0}}]},
4]/.triangle[pts_]:>Point/@pts;
Show[Graphics[{(N at Last@gp)}],AspectRatio->Automatic];
(*Pinwheel tiling variation*)
Clear[gp];
gp=NestList[(#/.triangle[{a_,b_,c_}]:>
Module[{w,x,y,z},w=(a+b)/2;x=(c-a)/5*2+a;y=(c-a)/5*4+a;
z=(b+y)/2;{triangle[{a,x,w}],triangle[{w,z,b}],
triangle[{b,y,c}],triangle[{z,w,x}],triangle[{x,y,z}]}])&,{
triangle[{{0,0},{2/Sqrt[5],0},{2/Sqrt[5],1/Sqrt[5]}}]},4];
gp=Transpose at {
Table[{Thickness[.0005+i/150],Hue[.7,i,.8]},{i,0,1,
1/(Length at gp-1)}],Reverse at gp}/.pat:{_Thickness,_Hue}:>
Sequence@@pat/.triangle[{a_,rest__}]:>Line[{a,rest,a}];
Show[Graphics[{(N at gp)}],AspectRatio->Automatic];
(*Pinwheel tiling variation, vertexes*)
Clear[gp];
gp=NestList[(#/.triangle[{a_,b_,c_}]:>
Module[{w,x,y,z},w=(a+b)/2;x=(c-a)/5*2+a;y=(c-a)/5*4+a;
z=(b+y)/2;{triangle[{a,x,w}],triangle[{w,z,b}],
triangle[{b,y,c}],triangle[{z,w,x}],triangle[{x,y,z}]}])&,{
triangle[{{0,0},{2/Sqrt[5],0},{2/Sqrt[5],1/Sqrt[5]}}],
triangle[{{2/Sqrt[5],1/Sqrt[5]},{0,1/Sqrt[5]},{0,0}}]},4];
gp=Transpose at {
Table[{Thickness[.0005+i/150],Hue[.7,i,.8]},{i,0,1,
1/(Length at gp-1)}],Reverse at gp}/.pat:{_Thickness,_Hue}:>
Sequence@@pat/.triangle[pts_]:>Point/@pts;
Show[Graphics[{(N at gp)}],AspectRatio->Automatic];
Xah, xah at best.com
http://www.best.com/~xah/Wallpaper_dir/c0_WallPaper.html
Mountain View, CA, USA