Clean Tile Problem

Author

Eric W. Weisstein
April 22, 2004

This notebook downloaded from http://mathworld.wolfram.com/notebooks/ComputationalGeometry/CleanTileProblem.nb.

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

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

Square Grid

Two Tiles

Solve[(1-x)^2==1-(1-x)^2,x]

N[%]

Simplify[(1-(1/2) (2-(Sqrt[2])))]

<<Graphics`Colors`

Coin[x_,r_]:={{Yellow,Disk[x,r]},Circle[x,r]}

Show[Graphics[{
{LightYellow,Polygon[{{-1,-1},{1,-1},{1,1},{-1,1}}]},
Line[{{-1,-1},{1,-1},{1,1},{-1,1},{-1,-1}}],
{Dashing[{.02}],Line[1/(Sqrt[2]){{-1,-1},{1,-1},{1,1},{-1,1},{-1,-1}}]},
Coin[{1/(Sqrt[2]),0},(1/2) (2-(Sqrt[2]))]
}],AspectRatio->Automatic]

Animation

SquareGrid[x_,y_]:={
Line[{{0,#},{y,#}}]&/@Range[0,x],
Line[{{#,0},{#,x}}]&/@Range[0,y]
}

ColoredDisk[xy_,r_,c_]:={{c,Disk[xy,r]},Circle[xy,r]}

d4=(1/2) (2-(Sqrt[2]));

CrackQ[xy_,d_]:=Or@@Thread[Abs[Mod[xy,1,-1/2]]<d/2]

DensityPlot[If[CrackQ[{x,y},d4],0,1],{x,0,5},{y,0,5},Mesh->False,PlotPoints->150,Epilog->{{Red,SquareGrid[6,6]}}]

Count[CrackQ[#,(2-Sqrt[2])/2]&/@Table[5Random[],{10^5},{2}],True]//Timing

Count[CrackQ[#,(2-Sqrt[2])/2]&/@Table[5Random[],{10^4},{2}],True]//Timing

padded[d_]:=Switch[d,0,"   ",_?(#<10&),"  ",_?(#<100&)," ",_,""]<>ToString[d]

MakeBoxes[label[k_,n_],TraditionalForm]:=RowBox[{RowBox[{padded[k],"  ","/"," ",padded[n]}],"  ",RowBox[{"(",RowBox[{padded[Floor[100k/n]]<>"."<>ToString[Round[Mod[100k/n,1]]],"%"}],")"}]}]

cracks=0;
g={};
d=(1/2) (2-(Sqrt[2]));
nmax=100;
movie=Table[
Show[Graphics[{
SquareGrid[5,5],
AppendTo[g,ColoredDisk[#,d/2,If[CrackQ[#,d],cracks++;Red,Yellow]]&@Table[5Random[],{2}]]
},
PlotLabel->TraditionalForm[label[cracks,n]],
PlotRange->Table[{-d/2,5+d/2},{2}],
AspectRatio->Automatic]
],{n,nmax}];

Show[GraphicsArray[Partition[Take[movie,{1,100,14}],4]]]

<<Utilities`GIF`;

Export[gifs<>"CleanTileSquare.gif",movie]//Timing

2 Tiles

d=.

d2=(1/2) (2-(Sqrt[2]));
polyline[x__]:={{Hue[.5],Polygon[x]},Line[x]}
Show[Graphics[{
polyline[{{-1,-1+d2},{-1+d2,-1+d2},{-1+d2,1-d2},{-1,1-d2}}/2],
polyline[{{1,-1+d2},{1-d2,-1+d2},{1-d2,1-d2},{1,1-d2}}/2],
polyline[Reverse/@{{-1,-1+d2},{-1+d2,-1+d2},{-1+d2,1-d2},{-1,1-d2}}/2],
polyline[Reverse/@{{1,-1+d2},{1-d2,-1+d2},{1-d2,1-d2},{1,1-d2}}/2],
Line[{{-1,-1},{-1,1},{1,1},{1,-1},{-1,-1}}/2],
Text[1-d/l,{0,.28},FormatType->TraditionalForm],
Text[d/(2l),{.57,.43},FormatType->TraditionalForm]
}],AspectRatio->Automatic]

4(1-x)x/2

Simplify[1-(1-x)^2-(1-(1/4)π)x^2-(1/4)π x^2]

3 Tiles

<<Graphics`InequalityGraphics`

pts=Select[Table[Random[Real,{-1,1}/2],{20},{2}],Norm[#]>1/2&]

Show[GraphicsArray[Graphics[{
InequalityPlot[x^2+y^2>1/4&&Max[Abs[x],Abs[y]]<1/2,{x},{y},DisplayFunction->Identity][[1]],Line[{{-1,0},{1,0}}1.2],
Circle[#,1/2],
PointSize[.04],Point[#],
Line[{{0,-1},{0,1}}1.1],
Line[{{-1,-1},{-1,1}}/2],Line[{{1,-1},{1,1}}/2]
},AspectRatio->Automatic]&/@{{0.47265439179502144`,0.45356313963897743`},{0.34804938667557783`,-0.36432390859222225`}}]]

4 Tiles

pts=Select[Table[Random[Real,{-1,1}/2],{10},{2}],Norm[#]<1/2&]

Show[GraphicsArray[Graphics[{
{Hue[.5],Disk[{0,0},1/2]},
Circle[{0,0},1/2],
Circle[#,1/2],
PointSize[.04],Point[#],
Line[{{-1,0},{1,0}}1.1],
Line[{{0,-1},{0,1}}1.1]
},AspectRatio->Automatic]&/@Take[pts,2]]]

Triangular Grid

Cot[30Degree]

Solve[(1-Sqrt[3]x)^2==1-(1-Sqrt[3]x)^2,x]

N[%]

Simplify[Sqrt[(Sqrt[3]d/2)^2+(d/2)^2],d>0]

d3=(1/6) (2 (Sqrt[3])-(Sqrt[6]));

Show[Graphics[{
{LightYellow,Polygon[Table[{Sin[2Pi i/3],Cos[2Pi i/3]},{i,0,2}]/Sqrt[3]]},
Line[Table[{Sin[2Pi i/3],Cos[2Pi i/3]},{i,0,3}]/Sqrt[3]],
{Dashing[{.02}],Line[Table[{Sin[2Pi i/3],Cos[2Pi i/3]},{i,0,3}](1/Sqrt[3]-d3)]},
Coin[{0,-.2},d3/2]
}],AspectRatio->Automatic]

Triangle[x_]:=Line[x+1/Sqrt[3]#&/@(Through[{Cos,Sin}[2Pi(#-1/4)/3]]&/@Range[0,3])]
TriangularGrid[x_,y_]:=Module[{i,j},
Table[Triangle[{(i+Mod[j,2]/2),3/2/Sqrt[3]j}],{i,x},{j,y}]
]

Union[Last/@Flatten[Identity@@@Flatten[TriangularGrid[2,2]],1]//Simplify]

Union[First/@Flatten[Identity@@@Flatten[TriangularGrid[2,2]],1]//Simplify]

5/2/Sqrt[3]-1/Sqrt[3]

2 5 8

3/Sqrt[3]/2

Norm/@(Subtract@@@Partition[Triangle[{0,0}][[1]],2,1])

Show[Graphics[TriangularGrid[6,6]],
PlotRange->{{1,5},{1,5}},
AspectRatio->Automatic]

RotationMatrix[x_]:={{Cos[x],Sin[x]},{-Sin[x],Cos[x]}}

CrackQ[xy_,d_]:=Abs[Mod[Last[xy]-1/Sqrt[3],Sqrt[3]/2,-Sqrt[3]/4]]<d/2

CrackQ[xy_,d_]:=Abs[Mod[Last[RotationMatrix[2 Pi/3].xy-1/Sqrt[3]],Sqrt[3]/2,-Sqrt[3]/4]]<d/2

CrackQ[xy_,d_]:=Abs[Mod[Last[RotationMatrix[4Pi/3].xy-1/Sqrt[3]],Sqrt[3]/2,-Sqrt[3]/4]]<d/2

CrackQ[xy_,d_]:=Or@@Thread[Table[Abs[Mod[Last[RotationMatrix[2n Pi/3].xy-1/Sqrt[3]],Sqrt[3]/2,-Sqrt[3]/4]],{n,0,2}]<d/2]

DensityPlot[If[CrackQ[{x,y},d3],0,1],{x,1,5},{y,1,5},Mesh->False,PlotPoints->150,Epilog->{{Red,TriangularGrid[6,6]}}]//Timing

Count[CrackQ[#,d3]&/@Table[5Random[],{10^4},{2}],True]//Timing

d3

cracks=0;
g={};
d=d3;
nmax=100;
movie=Table[
Show[Graphics[{
{LightYellow,Polygon[{{0,0},{1,0},{1,1},{0,1}}100]},
TriangularGrid[8,8],
AppendTo[g,ColoredDisk[#,d/2,If[CrackQ[#,d],cracks++;Red,Yellow]]&@Table[Random[Real,{1,5}],{2}]]
},
PlotLabel->TraditionalForm[label[cracks,n]],
PlotRange->{{1,5},{1,5}},
AspectRatio->Automatic]
],{n,nmax}];

Show[GraphicsArray[Partition[Take[movie,{1,100,14}],4]]]

<<Utilities`GIF`;

Export[gifs<>"CleanTileTriangle.gif",movie]//Timing

Hexagonal Grid

Sec[30Degree]

Solve[(1-1/Sqrt[3]x)^2==1-(1-1/Sqrt[3]x)^2,x]

N[%]

d6=(1/2) (2 (Sqrt[3])-(Sqrt[6]));

Show[Graphics[{
{LightYellow,Polygon[Table[{Cos[2Pi i/6],Sin[2Pi i/6]},{i,0,6}]]},
Line[Table[{Cos[2Pi i/6],Sin[2Pi i/6]},{i,0,6}]],
{Dashing[{.02}],Line[Table[{Cos[2Pi i/6],Sin[2Pi i/6]},{i,0,6}](1-d6/Sqrt[3])]},
Coin[{0,-.61},d6/2]
}],AspectRatio->Automatic]

Hexagon[x_]:=Line[x+#&/@(Through[{Cos,Sin}[Pi#/3]]&/@Range[0,6])]

HexagonalGrid[x_,y_]:=Module[{i,j},
Table[Hexagon[{3/2i,Sqrt[3]j+Mod[i,2]Sqrt[3]/2}],{i,x},{j,y}]
]

Union[Last/@Flatten[Identity@@@Flatten[TriangularGrid[2,2]],1]//Simplify]

Union[First/@Flatten[Identity@@@Flatten[TriangularGrid[2,2]],1]//Simplify]

5/2/Sqrt[3]-1/Sqrt[3]

2 5 8

3/Sqrt[3]/2

Hexagon[{0,0}]

Norm/@(Subtract@@@Partition[Hexagon[{0,0}][[1]],2,1])

Show[Graphics[HexagonalGrid[7,7]],
PlotRange->{{.7,10.2},{.7,10.2}},
AspectRatio->Automatic]

RotationMatrix[x_]:={{Cos[x],Sin[x]},{-Sin[x],Cos[x]}}

CrackQ[xy_,d_]:=With[{o=Sqrt[3]},Abs[Mod[Last[xy]+o/2Mod[Floor[First[xy]/o],2],o,-o/2]]<d/2]

DensityPlot[If[CrackQ[{x,y},d3],0,1],{x,1,8},{y,1,8},Mesh->False,PlotPoints->100,Epilog->{{Red,HexagonalGrid[8,8]}}]//Timing

Count[CrackQ[#,d3]&/@Table[5Random[],{10^4},{2}],True]//Timing

d6

cracks=0;
g={};
d=d6;
nmax=20;
movie=Table[
Show[Graphics[{
{LightYellow,Polygon[{{0,0},{1,0},{1,1},{0,1}}100]},
HexagonalGrid[16,16],
AppendTo[g,ColoredDisk[#,d/2,If[CrackQ[#,d],cracks++;Red,Yellow]]&@Table[Random[Real,{1,10}],{2}]]
},
PlotLabel->TraditionalForm[label[cracks,n]],
PlotRange->{{1,10},{1,10}},
AspectRatio->Automatic]
],{n,nmax}];

Show[GraphicsArray[Partition[Take[movie,{1,100,14}],4]]]

<<Utilities`GIF`;

Export[gifs<>"CleanTileHexagon.gif",movie]//Timing

Rhombus

FullSimplify[Cot[θ]+Tan[θ]]

(1-(1/2)x Csc[θ]Sec[θ])^2/.θ->Pi/4

Solve[(1-(1/2)x Csc[θ]Sec[θ])^2==1-(1-(1/2)x Csc[θ]Sec[θ])^2,x]

N[%775]/.θ->Pi/6

1/3.94239

With[{θ=30 Degree},
p=2Cos[θ];
q=2Sin[θ];
d=-(-2+(Sqrt[2])) Cos[θ] Sin[θ];
p2=p-d Csc[θ];
q2=q-d Sec[θ];
Show[Graphics[{
{LightYellow,Polygon[{{-p,0},{0,-q},{p,0},{0,q}}/2]},
Line[{{-p,0},{0,-q},{p,0},{0,q},{-p,0}}/2],
{Dashing[{.02}],Line[{{-p2,0},{0,-q2},{p2,0},{0,q2},{-p2,0}}/2]},
Coin[{.55,.39}/2,d/2]
}],AspectRatio->Automatic,PlotRange->All]
]