Square Tiling

Author

Eric W. Weisstein
March 5, 2025

This notebook downloaded from http://mathworld.wolfram.com/notebooks/Tilings/SquareTiling.nb.

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

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

Squares in an n×n grid

Squares

Formula

A000330

Sum[(k^2),{k,n}]

Table[(1/6) n (1+n) (1+2 n),{n,10}]

Code

SquareConfigurationQ[v_]:=Module[
{
sides=Partition[v,2,1,1]
},
And[
Length[sides]==4, (* exclude lines *)
sides[[1,1,1]]==sides[[1,2,1]]||sides[[1,1,2]]==sides[[1,2,2]], (* exclude diamonds *)
Equal@@(SquaredEuclideanDistance@@@sides)
]
]

CountSquares[n_]:=Module[{v=Tuples[Range[0,n],2],sub},
(* don't use PolygonCoordinates; it re-orders *)
(*
PolygonCoordinates@Polygon[{{0, 0}, {1, 0}, {1, 1}, {0, 1}}, {1, 2, 3, 4}]
{{0,0},{0,1},{1,0},{1,1}}
*)
sub=Normal[ConvexHullRegion[#]][[1]]&/@Subsets[v,{4}];
Select[sub,SquareConfigurationQ]
]

SquareGrid[n_]:=Join[
Table[Line[{{0,i},{n,i}}],{i,0,n}],
Table[Line[{{i,0},{i,n}}],{i,0,n}]
]

squares1=CountSquares[1]

gr1=Graphics[{Gray,SquareGrid[1],Red,ClosedLine[#]}]&/@squares1

squares2=CountSquares[2]

gr2=Graphics[{Gray,SquareGrid[2],Red,ClosedLine[#]}]&/@squares2

Length[squares3=CountSquares[3]]//Timing

gr3=Graphics[{Gray,SquareGrid[3],Red,ClosedLine[#]}]&/@squares3

Length[squares4=CountSquares[4]]//Timing

Figure

GraphicsGrid[Flatten[Partition[#,UpTo[7]]&/@{gr1,gr2,gr3},1]]

Squares or diamonds

Formula

A002415

Table[n^2(n^2-1)/12,{n,10}]

(n+1)^2((n+1)^2-1)/12//Factor

Table[(1/12) n (((1+n))^2) (2+n),{n,10}]

Code

SquareOrDiamondConfigurationQ[v_]:=Module[
{
sides=Partition[v,2,1,1]
},
And[
Length[sides]==4, (* exclude lines *)
Dot[Subtract@@sides[[1]],Subtract@@sides[[2]]]==0,(* exclude non-square rhombuses *)
Equal@@(SquaredEuclideanDistance@@@sides)
]
]

CountSquaresOrDiamonds[n_]:=Module[{v=Tuples[Range[0,n],2],sub},
(* don't use PolygonCoordinates; it re-orders *)
(*
PolygonCoordinates@Polygon[{{0, 0}, {1, 0}, {1, 1}, {0, 1}}, {1, 2, 3, 4}]
{{0,0},{0,1},{1,0},{1,1}}
*)
sub=Normal[ConvexHullRegion[#]][[1]]&/@Subsets[v,{4}];
Select[sub,SquareOrDiamondConfigurationQ]
]

SquareGrid[n_]:=Join[
Table[Line[{{0,i},{n,i}}],{i,0,n}],
Table[Line[{{i,0},{i,n}}],{i,0,n}]
]

squares1=CountSquaresOrDiamonds[1]

gr1=Graphics[{Gray,SquareGrid[1],Red,ClosedLine[#]}]&/@squares1

Length[squares2=CountSquaresOrDiamonds[2]]

gr2=Graphics[{Gray,SquareGrid[2],Red,ClosedLine[#]}]&/@squares2

Length[squares3=CountSquaresOrDiamonds[3]]//Timing

gr3=Graphics[{Gray,SquareGrid[3],Red,ClosedLine[#]}]&/@squares3

Length[squares4=CountSquaresOrDiamonds[4]]//Timing

Length[squares5=CountSquaresOrDiamonds[5]]//Timing

Length[squares6=CountSquaresOrDiamonds[6]]//Timing

Figure

GraphicsGrid[Flatten[Partition[#,UpTo[7]]&/@{gr1,gr2,gr3},1]]

Right Triangles

Right triangleswith edge lengths in the proportion 1:2:(Sqrt[5]) and having no two such triangles the same size also tile the square.  The best known solution has 8 triangles (Berlekamp 1999).

PolygonAngle[SSSTriangle[1,2,Sqrt[5]]]//FullSimplify

Non-right triangles that tile the square with similar copies

Laczkovich (1990) proved that there are exactly three shapes of non-right triangles that tile the square with similar copies, corresponding to angles:

{{Pi/8,Pi/4,5Pi/8},{Pi/4,Pi/3,5Pi/12},{Pi/12,Pi/4,2Pi/3}}/Degree//FunctionExpand

{45, 60, 75}-probable minimal solution

https://community.wolfram.com/groups/-/m/t/3408096

In the Laczkovich paper, the proof outlined thousands of 45°-60°-75° triangles with no picture. Tom Sirgedas got it down to 32 triangles, which is believed minimal.

s=Sqrt[3];
vv={{1968-72s,396+12s},{2340-324s,1152-360s},{2220-196s,528+16s},{1584+48s,396+12s},{2352-192s,396+12s},{2340-324s,0},{1188+36s,0},{2346-258s,198+6s},{2544-252s,0},{2550-186s,198+6s},{2565-21s,693+21s},{612+216s,612+216s},{0,0},{3258,0},{3258,2016-630s},{2340-324s,2340-324s},{3258,3258}};ff={{1,2,3},{4,2,1},{5,1,3},{6,4,5},{7,6,4},{8,9,10},{9,8,6},{10,5,8},{11,10,3},{12,2,7},{13,7,12},{14,11,9},{14,15,11},{16,12,2},{15,2,16},{17,16,15}};

Diagram

Graphics[{
EdgeForm[Directive[Black,Thickness[.002]]],Opacity[.8],{Hue[Area[Polygon[vv[[#]]]]],Polygon[vv[[#]]],Polygon[3258-vv[[#]]]}&/@ff
}]

Triangle count

Length[ff]

Length[triangles=Flatten[{Polygon[vv[[#]]],Polygon[3258-vv[[#]]]}&/@ff]]

Angles

Tally[NumericalSort[PolygonAngle[#]]&/@triangles]

Side lengths

<<MathWorld`PlaneGeometry`

sidelengthtallies=RootReduce[NumericalSort[SideLengths[#]]&/@triangles]//Tally

Length[sidelengthtallies]

Tally[sidelengthtallies[[All,2]]]

Area sum

Total[Area/@triangles]//Expand

MinMax/@Transpose[Join@@(PolygonCoordinates/@triangles)]

(3258^2)

RegionIntersection

Length[pairs=Subsets[triangles,{2}]]

Original

SystemInformation["Small"]

bug(457964): RegionIntersection[tri1, tri2] incorrectly reports a point for triangles which intersect along an edge

Length[int=RegionIntersection@@@pairs]

Tally[Head/@int]

Take[int,2]

line=Position[int,Line,∞][[All,1]]

GraphicsGrid[Partition[Graphics[Transpose[{{Red,Blue},pairs[[#]]}]]&/@line,UpTo[10]]]

point=Position[int,Point,∞][[All,1]]

GraphicsGrid[Partition[Graphics[Transpose[{{Red,Blue},pairs[[#]]}]]&/@point,UpTo[10]]]

pairs[[point[[20]]]]//InputForm

triangles={Polygon[{{2352-192 (Sqrt[3]),396+12 (Sqrt[3])},{1968-72 (Sqrt[3]),396+12 (Sqrt[3])},{2220-196 (Sqrt[3]),528+16 (Sqrt[3])}}],Polygon[{{2565-21 (Sqrt[3]),693+21 (Sqrt[3])},{2550-186 (Sqrt[3]),198+6 (Sqrt[3])},{2220-196 (Sqrt[3]),528+16 (Sqrt[3])}}]};

Graphics[Transpose[{{Red,Blue},triangles}]]

RegionIntersection@@triangles

lines=(Line/@Partition[#[[1]],2,1,1])&/@triangles

ints=Flatten[Outer[{#,#2,RegionIntersection[#,#2]}&,Sequence@@lines],1]

ints[[8,2]]

N[%]

GraphicsGrid[Partition[Graphics[{#,#2,Red,AbsolutePointSize[7],#3}]&@@@ints,UpTo[5]],Dividers->All]

FullSimplify

Length[int=RegionIntersection@@@FullSimplify[pairs]]

Tally[Head/@int]

line=Position[int,Line,∞][[All,1]]

Graphics[Transpose[{{Red,Blue},pairs[[#]]}]]&/@line

point=Position[int,Point,∞][[All,1]]

Graphics[Transpose[{{Red,Blue},pairs[[#]]}]]&/@point

RegionDisjoint

Length[disj1=RegionDisjoint@@@pairs]

Length[disj2=RegionDisjoint@@@FullSimplify[pairs]]

disj1===disj2

Take[disj,10]

Graphics[Transpose[{{Red,Blue},#}],Background->Lighter[#,.9]&@If[RegionDisjoint@@#,Green,Red]]&/@pairs

RegionDistance

Length[dist1=RegionDistance@@@pairs]

Length[dist2=RegionDistance@@@FullSimplify[pairs]]

FullSimplify@dist1===dist2

dist1-dist2//Chop//Tally

Graphics[Transpose[{{Red,Blue},#}],Background->Lighter[#,.9]&@If[RegionDistance@@#>0,Green,Red]]&/@pairs