Minimal Inequivalent Square Tilings

A dataset of the minimal inequivalent square tilings with the allowed tiles that generate the tiling and an image of the tile generated

This dataset is sourced from pages 214 and 215 of A New Kind of Science (Wolfram, 2002)

(4 columns, 171 rows)

Examples

Basic Examples

Retrieve the ResourceObject:

In[1]:=
ResourceObject["Minimal Inequivalent Square Tilings"]
Out[1]=

View the data:

In[2]:=
ResourceData["Minimal Inequivalent Square Tilings"]
Out[2]=

Visualization

Choose a random constraint:

In[3]:=
RandomChoice[
  ResourceData[
   "Minimal Inequivalent Square Tilings"]]["ConstraintNumber"]
Out[3]=

Generate a 20 x 20 plot of its tiling pattern:

In[4]:=
With[{
  tilingFunction = 
   ResourceData["Minimal Inequivalent Square Tilings", 
    "TilingFunction"],
  constraintData =
   First@Normal@
     ResourceData["Minimal Inequivalent Square Tilings"][
      Select[#ConstraintNumber == 43803970 &]]
  },
 ArrayPlot@tilingFunction[
   constraintData["TilingSequence"],
   constraintData["ConstraintSequences"],
   {20, 20}]
 ]
Out[4]=

Plot the first allowed tile:

In[5]:=
With[{constraintData = 
   First@Normal@
     ResourceData["Minimal Inequivalent Square Tilings"][
      Select[#ConstraintNumber == 43803970 &]]},
 ArrayPlot[First@constraintData["AllowedTiles"], 
  ColorRules -> {Except[1 | 0] -> GrayLevel[.6]},
  Background -> GrayLevel[.6]]
 ]
Out[5]=

Highlight instances of the tile on the array:

In[6]:=
With[{
  tilingFunction = 
   ResourceData["Minimal Inequivalent Square Tilings", 
    "TilingFunction"],
  constraintData =
   First@Normal@
     ResourceData["Minimal Inequivalent Square Tilings"][
      Select[#ConstraintNumber == 43803970 &]]
  },
 With[{
   array =
    tilingFunction[
     constraintData["TilingSequence"],
     constraintData["ConstraintSequences"],
     {20, 20}],
   tile =
    First@constraintData["AllowedTiles"]
   },
  With[{
    positions =
     Join @@
      
      Table[p + # & /@ {{0, 1}, {1, 0}, {1, 1}, {1, 2}, {2, 1}},
       {p,
        With[{rowPositions =
           Table[
            Join @@
             MapIndexed[
              
              Thread[{First@#2, 
                 First /@ SequencePosition[#, tileRow]}] &,
              array
              ],
            {tileRow, tile}
            ]
          },
         Select[First@rowPositions,
          MemberQ[rowPositions[[2]],
             ReplacePart[#, 1 -> #[[1]] + 1]
             ] &&
            MemberQ[rowPositions[[3]],
             ReplacePart[#, 1 -> #[[1]] + 2]
             ] &
          ]
         ]
        }]
    },
   ReplacePart[array,
     i : Alternatives @@ positions :>
      Replace[array[[Sequence @@ i]], {
        0 -> .1,
        1 -> .9
        }
       ]
     ]
    // ArrayPlot[#,
      ColorRules -> {0 -> White, .1 -> GrayLevel[.8], 
        1 -> Black, .9 -> GrayLevel[.6]}
      ] &
   ]
  ]
 ]
Out[6]=

Wolfram Research, "Minimal Inequivalent Square Tilings" from the Wolfram Data Repository. (2017) https://doi.org/10.24097/wolfram.00988.data

License Information

CC BY-SA 4.0

Source Metadata

Data Downloads