Function Repository Resource:

GenerateHexagonalWangTiling

Source Notebook

Generate a hexagonal tiling pattern from a set of hexagonal Wang tiles

Contributed by: Bowen Ping

ResourceFunction["GenerateHexagonalWangTiling"][tiles, init, n]

covers a n-layer hexagonal array with edge-matching Wang tiles, with init as the tile in the center.

Details

In the specification, init can be {} for no fixed tile.
Hexagonal Wang tiles are similar to square Wang tiles, except they have six edges rather than four.
Each element in tiles is a 6-element list, indicating the six colors numbered from southwest then counter clockwise: .
Option "Count" set the number of satisfiability instances. When "Count"All is set, it gives all possible tilings.

Examples

Basic Examples (4) 

Generate a 1-layer hexagonal tiling with only one Hexagonal Wang tile:

In[1]:=
ResourceFunction[
 "GenerateHexagonalWangTiling"][{{0, 1, 2, 0, 1, 2}}, {}, 2]
Out[1]=

Depict the tiling result:

In[2]:=
With[{tiles = {{0, 1, 2, 0, 1, 2}}, size = 2, depictFunction = Function[{tiles, size, result}, 
Map[With[{pos = Mean[
Catenate[
Part[#, All, 1]]]}, {
MapApply[{
EdgeForm[LightGray], 
Opacity[0.9], #2, 
Polygon[{pos, 
Apply[Sequence, #]}]}& , #], {
EdgeForm[
Directive[Black]], 
Opacity[0], 
Polygon[
CirclePoints[pos, {2, Pi}, 6]]}}]& , 
MapThread[# -> Hue[#2/(Max[tiles] + 1)]& , {
Map[Partition[
CirclePoints[#, {2, Pi}, 6], 2, 1, 1]& , 
DeleteDuplicates[
Catenate[
NestList[DeleteDuplicates[
Catenate[
Map[CirclePoints[#, {2 Sqrt[3], 7 (Pi/6)}, 6]& , #]]]& , {{0, 0}}, size]]]], result}, 2]]]},
 Graphics[
  depictFunction[tiles, size, ResourceFunction["GenerateHexagonalWangTiling"][tiles, {}, size]], ImageSize -> 200]
 ]
Out[2]=

Set the tile in the center:

In[3]:=
With[{tiles = {{0, 1, 2, 0, 1, 2}, {2, 0, 1, 2, 0, 1}, {1, 2, 0, 1, 2,
      0}}, size = 2, depictFunction = Function[{tiles, size, result}, 
Map[With[{pos = Mean[
Catenate[
Part[#, All, 1]]]}, {
MapApply[{
EdgeForm[LightGray], 
Opacity[0.9], #2, 
Polygon[{pos, 
Apply[Sequence, #]}]}& , #], {
EdgeForm[
Directive[Black]], 
Opacity[0], 
Polygon[
CirclePoints[pos, {2, Pi}, 6]]}}]& , 
MapThread[# -> Hue[#2/(Max[tiles] + 1)]& , {
Map[Partition[
CirclePoints[#, {2, Pi}, 6], 2, 1, 1]& , 
DeleteDuplicates[
Catenate[
NestList[DeleteDuplicates[
Catenate[
Map[CirclePoints[#, {2 Sqrt[3], 7 (Pi/6)}, 6]& , #]]]& , {{0, 0}}, size]]]], result}, 2]]]},
 Graphics[
  depictFunction[tiles, size, ResourceFunction["GenerateHexagonalWangTiling"][
    tiles, {1, 2, 0, 1, 2, 0}, size]], ImageSize -> 200]
 ]
Out[3]=

Make a bigger patch with 4-layer surroundings:

In[4]:=
With[{tiles = {{1, 0, 1, 1, 0, 1}}, size = 4, depictFunction = Function[{tiles, size, result}, 
Map[With[{pos = Mean[
Catenate[
Part[#, All, 1]]]}, {
MapApply[{
EdgeForm[LightGray], 
Opacity[0.9], #2, 
Polygon[{pos, 
Apply[Sequence, #]}]}& , #], {
EdgeForm[
Directive[Black]], 
Opacity[0], 
Polygon[
CirclePoints[pos, {2, Pi}, 6]]}}]& , 
MapThread[# -> Hue[#2/(Max[tiles] + 1)]& , {
Map[Partition[
CirclePoints[#, {2, Pi}, 6], 2, 1, 1]& , 
DeleteDuplicates[
Catenate[
NestList[DeleteDuplicates[
Catenate[
Map[CirclePoints[#, {2 Sqrt[3], 7 (Pi/6)}, 6]& , #]]]& , {{0, 0}}, size]]]], result}, 2]]]},
 Graphics[
  depictFunction[tiles, size, ResourceFunction["GenerateHexagonalWangTiling"][tiles, {}, size]], ImageSize -> 200]
 ]
Out[4]=

Scope (1) 

Generate aperiodic hexagonal Wang tiling:

In[5]:=
With[{tiles = CompressedData["
1:eJw1j8ENAzEIBDEYG2xTRPpIFSnhGkj/v8Be7mGNLI3Y3df1/VxMRO98Ix81
ll5Q6fmfKgYw0Nj67bhJOb4EDsC2DI4b0fbZ0tlrtil0HnibRmd7a0ZhxOkA
U0KIFSCdFmKkzcIza4/umbVP98o6fVXWGauy9lh5oPoAqw5Un7qTfepO9olQ
dA5F52B0TlRn4O/kvHJyOxyAH3SK3F6dc3t1rtH6ANu1dimcvINdDOcGsmrX
D9SMCUo=
"], size = 10, depictFunction = Function[{tiles, size, result}, 
Map[With[{pos = Mean[
Catenate[
Part[#, All, 1]]]}, {
MapApply[{
EdgeForm[LightGray], 
Opacity[0.9], #2, 
Polygon[{pos, 
Apply[Sequence, #]}]}& , #], {
EdgeForm[
Directive[Black]], 
Opacity[0], 
Polygon[
CirclePoints[pos, {2, Pi}, 6]]}}]& , 
MapThread[# -> Hue[#2/(Max[tiles] + 1)]& , {
Map[Partition[
CirclePoints[#, {2, Pi}, 6], 2, 1, 1]& , 
DeleteDuplicates[
Catenate[
NestList[DeleteDuplicates[
Catenate[
Map[CirclePoints[#, {2 Sqrt[3], 7 (Pi/6)}, 6]& , #]]]& , {{0, 0}}, size]]]], result}, 2]]]},
 With[{tiling = ResourceFunction["GenerateHexagonalWangTiling"][tiles, {}, size]},
  Labeled[
   Graphics[depictFunction[tiles, size, tiling, ImageSize -> 800]]
   , Grid[
    Partition[
     Graphics[{#, {EdgeForm[Black], Opacity[0], Polygon[CirclePoints[{0, 0}, {2, \[Pi]}, 6]]}}, ImageSize -> 20] &@
        MapThread[{Hue[#2], EdgeForm[LightGray], Polygon[{{0, 0}, Sequence @@ #1}]} &,
         {Partition[CirclePoints[{0, 0}, {2, \[Pi]}, 6], 2, 1, 1], #/(Max[tiles] + 1)}] & /@ tiles
     , 10]]]
  ]]
Out[5]=

Options (2) 

Give two different possible tilings using "Count":

In[6]:=
With[{tiles = {{1, 2, 0, 1, 2, 0}, {2, 0, 1, 2, 0, 1}, {0, 1, 2, 0, 1,
        2}, {1, 2, 0, 1, 2, 0}, {2, 0, 1, 2, 0, 1}, {0, 1, 2, 0, 1, 2}}, size = 3, depictFunction = Function[{tiles, size, result}, 
Map[With[{pos = Mean[
Catenate[
Part[#, All, 1]]]}, {
MapApply[{
EdgeForm[LightGray], 
Opacity[0.9], #2, 
Polygon[{pos, 
Apply[Sequence, #]}]}& , #], {
EdgeForm[
Directive[Black]], 
Opacity[0], 
Polygon[
CirclePoints[pos, {2, Pi}, 6]]}}]& , 
MapThread[# -> Hue[#2/(Max[tiles] + 1)]& , {
Map[Partition[
CirclePoints[#, {2, Pi}, 6], 2, 1, 1]& , 
DeleteDuplicates[
Catenate[
NestList[DeleteDuplicates[
Catenate[
Map[CirclePoints[#, {2 Sqrt[3], 7 (Pi/6)}, 6]& , #]]]& , {{0, 0}}, size]]]], result}, 2]]]},
   Graphics[depictFunction[tiles, size, #, ImageSize -> 200]] & /@ ResourceFunction["GenerateHexagonalWangTiling"][tiles, {}, size, "Count" -> 2]
   ] // List // Grid[#, Frame -> All, FrameStyle -> LightGray] &
Out[6]=

Give all possible tilings:

In[7]:=
With[{tiles = {{1, 2, 0, 1, 2, 0}, {2, 0, 1, 2, 0, 1}, {0, 1, 2, 0, 1,
        2}, {1, 2, 0, 1, 2, 0}, {2, 0, 1, 2, 0, 1}, {0, 1, 2, 0, 1, 2}}, size = 3, depictFunction = Function[{tiles, size, result}, 
Map[With[{pos = Mean[
Catenate[
Part[#, All, 1]]]}, {
MapApply[{
EdgeForm[LightGray], 
Opacity[0.9], #2, 
Polygon[{pos, 
Apply[Sequence, #]}]}& , #], {
EdgeForm[
Directive[Black]], 
Opacity[0], 
Polygon[
CirclePoints[pos, {2, Pi}, 6]]}}]& , 
MapThread[# -> Hue[#2/(Max[tiles] + 1)]& , {
Map[Partition[
CirclePoints[#, {2, Pi}, 6], 2, 1, 1]& , 
DeleteDuplicates[
Catenate[
NestList[DeleteDuplicates[
Catenate[
Map[CirclePoints[#, {2 Sqrt[3], 7 (Pi/6)}, 6]& , #]]]& , {{0, 0}}, size]]]], result}, 2]]]},
   Graphics[depictFunction[tiles, size, #, ImageSize -> 200]] & /@ ResourceFunction["GenerateHexagonalWangTiling"][tiles, {}, size, "Count" -> All]
   ] // List // Grid[#, Frame -> All, FrameStyle -> LightGray] &
Out[7]=

Properties and Relations (1) 

The number order in the 3-layer grid of the tiles is shown as following:

In[8]:=
With[{centerPoints = DeleteDuplicates[Catenate[
     NestList[
      DeleteDuplicates@
        Catenate[
         CirclePoints[#, {2 Sqrt[3], 7 Pi/6}, 6] & /@ #] &, {{0, 0}}, 3]
     ]]},
 Graphics[
  MapIndexed[{Opacity[1], EdgeForm[Black], White, Polygon[CirclePoints[#1, {2, Pi}, 6]], Black, Text[First[#2], #1]} &, centerPoints]]
 ]
Out[8]=

Neat Examples (1) 

Generate tilings of three different sets of aperiodic Hexagonal Wang tiles, all derived from the Hat tile:

In[9]:=
(* Evaluate this cell to get the example input *) CloudGet["https://www.wolframcloud.com/obj/4c7093e6-3139-426d-ac10-b6f0c5d7c11f"]
Out[9]=

Publisher

Bowen Ping

Version History

  • 1.0.0 – 13 November 2023

Related Resources

License Information