Message Boards

WOLFRAM COMMUNITY

6386 Views

4 Replies

12 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Staff Picks Computer Science Mathematics Visual Arts Computational Systems Geometry Graphics and Visualization Wolfram Language

Computable proof of Trilobite and Crab

Brad Klee

Posted 3 years ago

In a previous thread and a previous demonstration we computed some basic facts about Trilobite and Crab tiling, but did not bother to prove aperiodicity. Even the original author admits that a full proof is "not worth the readers time" (https://arxiv.org/pdf/1608.07167.pdf). While this may be true assuming the proof is checked by a human, it may not be true with computational assistance. Here we argue that the computable proof is worth $10$ or $15$ minutes it takes to check (assuming the software isn't making unseen mistakes). The strategy is simple: Given a representation of the tiling over five symbols--one blank crab, and one decorated trilobite in four rotations--first compute $2\times2$ and $3 \times 3$ atlases, and show that only $5$ of $49$ valid $3\times3$ templates are need to encompass the canonical completion obtained by adding $6$ tiles to each and every $2\times 2$ template. Canonical completions are so called because they are super-tiles of the five originals. Next we take and multiplex this set of $5$ into $5^9 \sim 2\times10^6$ possible super-super-tiles. After about $10$ minutes of computing, we need a little extra logic to prove closure of the atlas under inflation. This sets up an induction, which requires the chair hierarchy (modulo the known issue with fault lines). Utility Functions star = Join[IdentityMatrix[2], -IdentityMatrix[2]]; star2 = Plus @@ # & /@ Partition[star, 2, 1, 1]; ChairRep = {T[or_, 1] :> Join[{T[2 or, 1]}, MapThread[T[2 or + #1, #2] &, {star, Range[2, 5]}], T[2 or + #, 1] & /@ star2], T[or_, x_] :> Join[{T[2 or, x]}, MapThread[T[2 or + #1, If[Or[#2 == x + 2, #2 == x - 2], x, #2]] &, {star, RotateRight[Range[2, 5], 2]}], T[2 or + #, 1] & /@ star2]}; InflateList[n_] := NestList[Union[Flatten[# /. ChairRep]] &, {T[{0, 0}, 1]}, n] NeighborVals[data_, or_, verts_] := With[{verts2 = Map[Plus[or, #] &, verts]}, ReplaceAll[Cases[data, T[#, x_] :> x], {} -> {0}][[1]] & /@ verts2] GetTemplates[data_, verts_] := Select[ NeighborVals[data, #[[1]], verts ] -> #[[2]] & /@ data, ! MemberQ[#[[1]], 0] &] colRules = {1 -> Black, 0 -> White, 2 -> Hue[(2 - 1)/8], 3 -> Hue[(2 2 - 1)/8], 4 -> Lighter@Hue[(2 3 - 1)/8], 5 -> Lighter@Hue[(2 4 - 1)/8]}; Depict[v_, c_] := {c /. colRules, Rectangle[v]} DepictTemplate[rule_, verts_] := Graphics[{ EdgeForm[Black], Depict[{0, 0}, rule[[2]]], MapThread[Depict, {verts, rule[[1]]}]}] Calculate Atlases Using the substitution rule, we generate data and check to make sure we find all $2 \times2$ and $3 \times 3$ templates. In fact, once the $49$ larger templates are known, the $20$ smaller templates can be obtained by dissection. Graphics[{EdgeForm[Black], InflateList[4][[-1]] /. T -> Depict}] Length[ Union[GetTemplates[#, {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]]] & /@ InflateList[4] templates = Union[GetTemplates[#, Join[star, star2]]] & /@ InflateList[4]; SortedInds = Cases[Position[templates[[-1]], #], {x_, 2} :> x] & /@ Range[1, 5]; Length /@ templates Out[]= {0, 4, 20, 20, 20} Out[]= {0, 1, 21, 49, 49} (* These could prob. use more sorting ) SortedTemplates = Function[{inds}, SortBy[templates[[-1, inds]], Reverse[#[[1]]] &] ] /@ SortedInds; GraphicsGrid[ MapThread[#2[#1, Graphics[]] &, {Partition[ Show[DepictTemplate[#, Join[star, star2]], ImageSize -> 75 ] & /@ Flatten[SortedTemplates], 7], {Append, Prepend, Prepend, Append, Append, Append, Append}}]] This data was obtained previously, but here we sort to emphasize five special templates in the first column, which also define inflations of the five basic symbols. These are most important templates to understand, but the remaining templates in the first three lines are also needed for reducing subsequent structured tuples. Before that, we also need $2 \times 2$ templates. OnCenter = Cases[templates[[-1, All, 1]], {_, _, _, _, 1, 1, 1, 1}]; OffCenterB = Complement[templates[[-1, SortedInds[[1]], 1]], OnCenter]; OffCenterC = Complement[templates[[-1, All, 1]], Join[OnCenter, OffCenterB]]; TempToTiles[code_] := Prepend[ MapThread[T, {Join[star, star2], code}], T[{0, 0}, code /. templates[[-1]]]] CenterTiles = Sort[TempToTiles /@ OnCenter]; OffCenterBTiles = Sort[TempToTiles /@ OffCenterB]; OffCenterCTiles = Sort[TempToTiles /@ OffCenterC]; Atlas0 = Join[CenterTiles, OffCenterBTiles, OffCenterCTiles]; TwoAtlas0 = SortBy[Union[ Cases[#, T[{0, 0} \| {1, 0} \| {1, 1} \| {0, 1}, _] ] & /@ Atlas0], Sort[#[[All, 2]]] &]; Length[TwoAtlas0] Out[]=20 GraphicsGrid[ Transpose@ Partition[ Graphics[{EdgeForm[Thick], # /. T -> Depict}, ImageSize -> 100] & /@ TwoAtlas0, 4]] A Few Case Checks Although there are twenty $2 \times 2$ templates, up to rotation and reflection, only three are unique. We will now show how two of these three $2 \times 2$ templates are built uniquely into one of five special $3\times3$ templates. The remaining case is similar enough to leave as an exercise to the interested reader. Only one non-obvious lemma is needed: If two colored tiles have point-like adjacency, they must be related by a rotation of $\pm \pi/2$. Unfortunately, directionality is not obvious in this depiction, so we need to improve graphics before we can check anything. The new directions are drawn on top of a grid, Graphics[{Opacity[0], EdgeForm[Thick], Polygon[star2], Polygon[star], Polygon[star2/2], Function[{or}, Polygon[or + #/2 & /@ star2]] /@ star, Function[{or}, Polygon[or + #/2 & /@ star2]] /@ star2, Function[{or}, Polygon[or + #/2 & /@ star]] /@ star, Opacity[1], PointSize -> Large, Red, Point /@ (star/2), Point /@ (star/2 + star2/4), Green, Point /@ (star/2 + star2/4), Point /@ (star/2 + RotateRight[star2/4]), Blue, Point /@ (star/2 + star2/2), Point /@ (star/2 + RotateRight[star2/2])}] DepictTC[or_, dir_] := {White, EdgeForm[Thick], If[dir == 1, Darker@Gray, dir /. colRules], Polygon[2 or + # & /@ Flatten[Transpose[ {star/2, star/2 + star2/4, star/2 + star2/4, star/2 + star2/4 + RotateLeft[star2/2]}], 1]], Gray, Polygon[2 or + # & /@ #] & /@ Transpose[{star/2 + star2/4, star/2 + star2/2, star2, star/2 + star2/2 + RotateLeft[star2/2], star/2 + star2/4 + RotateLeft[star2/2]}], If[dir == 1, {}, Transpose[{Part[RotateRight[{2, 3, 4, 5}, 2], Complement[ Range[4], {RotateLeft[{1, 2, 3, 4}, dir - 2][[1]]}]] /. colRules, Function[{or2}, Polygon[2 or + or2 + #/2 & /@ star]] /@ star[[ Complement[ Range[4], {RotateLeft[{1, 2, 3, 4}, dir - 2][[1]]}] ]]}]]} GraphicsRow[ Graphics[DepictTC[{0, 0}, #], PlotRange -> {{-2, 2}, {-2, 2}}, ImageSize -> 100] & /@ Range[5]] Now it is more obvious that rotation by $\pi/2$ acts as permutation of colors. According to bumps and nicks, we also have made join rules slightly more obvious. For example, black can not join black. Also note that colors here do not really matter, because tiles have fixed orientations. Our five target images are then depicted as GraphicsGrid[{ Graphics[{EdgeForm[Thick], # /. T -> Depict}, ImageSize -> 150, PlotRange -> {{-2, 2} + {1/2, 1/2}, {-2, 2} + {1/2, 1/2}}] & /@ CenterTiles, Graphics[{EdgeForm[Thick], # /. T -> DepictTC}, ImageSize -> 150, PlotRange -> {2 {-2, 2}, 2 {-2, 2}}] & /@ CenterTiles}] And three characteristic pre-images are GraphicsGrid[{ Graphics[{EdgeForm[Thick], # /. T -> Depict}, ImageSize -> 150, PlotRange -> {{-2, 2} + {1/2, 1/2}, {-2, 2} + {1/2, 1/2}}] & /@ TwoAtlas0[[{1, 5, 15}]], Graphics[{EdgeForm[Thick], # /. T -> DepictTC}, ImageSize -> 150, PlotRange -> {2 {-2, 2}, 2 {-2, 2}}] & /@ TwoAtlas0[[{1, 5, 15}]]}] For the first case, we wrongly assume green neighbor to south, follow logical deductions, apply reflection symmetry, and finally complete with one extra black: In this graphical shorthand notation, circle-x's indicate placements forbidden by the corner rule, while red circles stand for "therefore". The second case is slightly easier: However, in the final completion we have ignored an equally valid pink-black-pink configuration for the top row. This is the notorious fault line issue, where it is legal to off-shift symmetry across an infinite line of trilobites, in this case yellow. To prove that fault lines must be infinitely long, we need one an alternating induction with two clauses: Thus to maintain asymmetry, the yellow line must extend indefinitely to the left. The third omitted case has a similar nuance, as should now be obvious. Logic for other seventeen cases can be written programmatically by applying symmetry transforms. To recap: If the $2 \times 2$ template has two black tiles, it maps uniquely to the black supertile. If the $2 \times 2$ template has only one black, it maps uniquely to the supertile of whichever colored tile occurs twice. Because these unique completions exist, we can use the five special $3 \times 3$ templates as supertiles. Next we must prove that these supertiles close under inflation to $7 \times 7$ templates. Edit: Nov. 9, 2:05 PM.* Suggestion that the following code (could be expanded on) also proves unique completion: TwoAtlasInds = Map[Position[Outer[Length@Intersection[#1, #2] &, TwoAtlas0 /. T[x_, y_] :> T[x - #, y], CenterTiles, 1], 4] &, {{0, 0}, {0, 1}, {1, 1}, {1, 0}}]; Length /@ TwoAtlasInds Complement[Flatten[TwoAtlasInds[[All, All, 1]]], Range[20]] TwoAtlasInds[[All, All, 2]] Out[]= {5, 5, 5, 5} Out[]= {} Out[]= {{1, 2, 3, 4, 5}, {1, 2, 3, 4, 5}, {1, 2, 3, 5, 4}, {1, 2, 3,5, 4}} Closure of Atlas under Inflation Almost all the thinking is done, we now less than ten minutes of compute time on a personal lap top computer. This time is used to first check $(3 \times 3)^2 $ tiles overlap correctly, reducing to $ 3^4 - 4 \times 7 - 4 = 49$ unique tiles in each non-conflicted $7 \times 7$ template. Additional checks must be performed at four black vertices where four $3\times3$ templates meet at a corner, then we obtain a relatively small set of only $71$ templates. ThreeByThree[code_, len_] := Union[Flatten[ MapThread[ CenterTiles[[#2]] /. T[or_, dir_] :> T[or + len #1, dir] &, {Prepend[Join[star, star2], {0, 0}], code}]]] (* about 7 minutes *) AbsoluteTiming[CodesFirstPass = Select[Tuples[Range[5], 9], SameQ[Length@ThreeByThree[#, 2], 49] &];][[1]]/60 filter[codes_, offset_, CheckTiles_, diff_] := Select[codes, Function[{code}, SameQ[Min[Length[ Complement[ ThreeByThree[code, 2] /. T[or_, dir_] :> T[or + offset, dir], #] ] & /@ CheckTiles], 49 - diff]][#] &]; CodesSecondPass = FoldList[filter[#1, #2, OffCenterBTiles, 9] &, CodesFirstPass, Tuples[{1, -1}, 2]]; Length /@ CodesSecondPass Out[]={339, 201, 133, 87, 71} SortedSecondPass = Function[{int}, Select[CodesSecondPass[[-1]], Count[#[[-4 ;; -1]], 1] == int &]] /@ Reverse[Range[0, 4]]; Length /@ SortedSecondPass Function[{int}, Length@Select[templates[[-1, All, 1]], Count[#[[-4 ;; -1]], 1] == int &]] /@ Reverse[Range[0, 4]] diffs = %% - % Total[%] Out[]={5, 0, 16, 24, 26} Out[]={5, 0, 4, 16, 24} Out[]={0, 0, 12, 8, 2} Out[]=22 GraphicsGrid[{Graphics[{EdgeForm[Black], ThreeByThree[#, 2] /. T -> Depict}, ImageSize -> 200] & /@ SortedSecondPass[[1]], Graphics[{EdgeForm[Black], ThreeByThree[#, 2] /. T -> DepictTC}, ImageSize -> 200] & /@ SortedSecondPass[[1]]}] We are very happy to find these exact $5$ super-super-tiles, and can complete closure by proving the remaining 22 cases are spurious. Fourteen are eliminated by extension of the corner matching rule, and eight more are ignored as valid but faulty. Examples of the two classes are given as: dCodes = Select[CodesSecondPass[[-1]], ! MemberQ[templates[[-1]], #[[2 ;; -1]] -> #[[1]]] & ]; Complement[#[[2 ;; -1]] -> #[[1]] & /@ Complement[CodesSecondPass[[-1]], dCodes], templates[[-1]]] Length[dCodes] SignalError = Join[ {1, _, _, _, _, #, _, #, _} & /@ Range[2, 5], {1, _, _, _, _, _, #, _, #} & /@ Range[2, 5], MapThread[{1, _, _, _, _, _, #1, _, #2} &, { Range[2, 5], RotateRight[Range[2, 5], 2]}], MapThread[{1, _, _, _, _, #1, _, #2, _} &, { Range[2, 5], RotateRight[Range[2, 5], 2]}]] dCodes2 = DeleteCases[dCodes, Alternatives @@ SignalError] GraphicsRow[ Show[#, ImageSize -> 400] & /@ {Graphics[{ThreeByThree[dCodes[[1]], 2] /. T -> DepictTC, Red, Thickness[0.01], Arrowheads[0.05], Arrow[{{0, 0}, {4, 4}}], Arrow[{{0, 0}, -{4, 4}}]}], Graphics[ThreeByThree[dCodes2[[1]], 2] /. T -> DepictTC] }] When the crab tiles are given orientations, matching signals propagate across the red axis, meeting at a conflict in on the central crab, thus invalidating the configuration. A really great idea is to program the trivial cellular automaton, which propagates crab directionality through the $7 \times 7$ super-super-tile, arriving at a conflict after only two time steps. For now we are happy with inspection, and invite the reader to look through all $22$ exceptions if necessary. The Induction Not much is left to be said. Since the first two atlases are identical up to scale, we have checked the base case of an induction which proceeds to say that successively larger $n^{th}$ order supertiles are proven combinatorially equivalent to the basic set of five symbols. At each step of the iteration, this requires orienting on black corners from the $(n-1)^{th}$ atlas to obtain a special set of only $5$ from the total set of $49$ . This process reveals the hierarchical symmetry and limit-periodicity of the five-color pattern. $\square$

Chair Growth

In a previous thread and a previous demonstration we computed some basic facts about Trilobite and Crab tiling, but did not bother to prove aperiodicity. Even the original author admits that a full proof is "not worth the readers time" (https://arxiv.org/pdf/1608.07167.pdf). While this may be true assuming the proof is checked by a human, it may not be true with computational assistance. Here we argue that the computable proof is worth $10$ or $15$ minutes it takes to check (assuming the software isn't making unseen mistakes).

The strategy is simple: Given a representation of the tiling over five symbols--one blank crab, and one decorated trilobite in four rotations--first compute $2\times2$ and $3 \times 3$ atlases, and show that only $5$ of $49$ valid $3\times3$ templates are need to encompass the canonical completion obtained by adding $6$ tiles to each and every $2\times 2$ template. Canonical completions are so called because they are super-tiles of the five originals. Next we take and multiplex this set of $5$ into $5^9 \sim 2\times10^6$ possible super-super-tiles. After about $10$ minutes of computing, we need a little extra logic to prove closure of the atlas under inflation. This sets up an induction, which requires the chair hierarchy (modulo the known issue with fault lines).

Utility Functions

star = Join[IdentityMatrix[2], -IdentityMatrix[2]];
star2 = Plus @@ # & /@ Partition[star, 2, 1, 1];

ChairRep = {T[or_, 1] :> Join[{T[2 or, 1]},
     MapThread[T[2 or + #1, #2] &, {star, Range[2, 5]}],
     T[2 or + #, 1] & /@ star2],
   T[or_, x_] :> Join[{T[2 or, x]}, MapThread[T[2 or + #1,
        If[Or[#2 == x + 2, #2 == x - 2], x, #2]] &,
      {star, RotateRight[Range[2, 5], 2]}], 
     T[2 or + #, 1] & /@ star2]};

InflateList[n_] := 
 NestList[Union[Flatten[# /. ChairRep]] &, {T[{0, 0}, 1]}, n]

NeighborVals[data_, or_, verts_] := 
 With[{verts2 = Map[Plus[or, #] &, verts]},
  ReplaceAll[Cases[data, T[#, x_] :> x], {} -> {0}][[1]] & /@ verts2]

GetTemplates[data_, verts_] := Select[
  NeighborVals[data, #[[1]], verts ] -> #[[2]] & /@ 
   data, ! MemberQ[#[[1]], 0] &]

colRules = {1 -> Black, 0 -> White,
   2 -> Hue[(2 - 1)/8], 3 -> Hue[(2 2 - 1)/8],
   4 -> Lighter@Hue[(2 3 - 1)/8], 5 -> Lighter@Hue[(2 4 - 1)/8]};

Depict[v_, c_] := {c /. colRules, Rectangle[v]}

DepictTemplate[rule_, verts_] := Graphics[{
   EdgeForm[Black], Depict[{0, 0}, rule[[2]]],
   MapThread[Depict, {verts, rule[[1]]}]}]

Calculate Atlases

Using the substitution rule, we generate data and check to make sure we find all $2 \times2$ and $3 \times 3$ templates. In fact, once the $49$ larger templates are known, the $20$ smaller templates can be obtained by dissection.

Graphics[{EdgeForm[Black], InflateList[4][[-1]] /. T -> Depict}]

Chair Data

Length[ Union[GetTemplates[#, {{0, 0}, {1, 0}, {1, 1}, {0, 1}}]]] & /@ InflateList[4]
templates = Union[GetTemplates[#, Join[star, star2]]] & /@ InflateList[4];
SortedInds = Cases[Position[templates[[-1]], #], {x_, 2} :> x] & /@ Range[1, 5];
Length /@ templates


Out[]= {0, 4, 20, 20, 20}
Out[]= {0, 1, 21, 49, 49}

 (* These could prob. use more sorting *)
SortedTemplates = Function[{inds},
    SortBy[templates[[-1, inds]], Reverse[#[[1]]] &]
    ] /@ SortedInds;

GraphicsGrid[
 MapThread[#2[#1, Graphics[]] &, {Partition[
    Show[DepictTemplate[#, Join[star, star2]], ImageSize -> 75
       ] & /@ Flatten[SortedTemplates], 7],
   {Append, Prepend, Prepend, Append, Append, Append, Append}}]]

49 templatess

This data was obtained previously, but here we sort to emphasize five special templates in the first column, which also define inflations of the five basic symbols. These are most important templates to understand, but the remaining templates in the first three lines are also needed for reducing subsequent structured tuples. Before that, we also need $2 \times 2$ templates.

OnCenter = Cases[templates[[-1, All, 1]], {_, _, _, _, 1, 1, 1, 1}];
OffCenterB = Complement[templates[[-1, SortedInds[[1]], 1]], OnCenter];
OffCenterC = Complement[templates[[-1, All, 1]], Join[OnCenter, OffCenterB]];

TempToTiles[code_] := Prepend[
  MapThread[T, {Join[star, star2], code}],
  T[{0, 0}, code /. templates[[-1]]]]

CenterTiles = Sort[TempToTiles /@ OnCenter];
OffCenterBTiles = Sort[TempToTiles /@ OffCenterB];
OffCenterCTiles = Sort[TempToTiles /@ OffCenterC];
Atlas0 = Join[CenterTiles, OffCenterBTiles, OffCenterCTiles];

TwoAtlas0 = SortBy[Union[ Cases[#, T[{0, 0} | {1, 0} | {1, 1} | {0, 1}, _]
   ] & /@ Atlas0], Sort[#[[All, 2]]] &];
Length[TwoAtlas0]

Out[]=20

GraphicsGrid[ Transpose@ Partition[
   Graphics[{EdgeForm[Thick], # /. T -> Depict}, ImageSize -> 100] & /@
     TwoAtlas0, 4]]

twenty templates

A Few Case Checks

Although there are twenty $2 \times 2$ templates, up to rotation and reflection, only three are unique. We will now show how two of these three $2 \times 2$ templates are built uniquely into one of five special $3\times3$ templates. The remaining case is similar enough to leave as an exercise to the interested reader. Only one non-obvious lemma is needed: If two colored tiles have point-like adjacency, they must be related by a rotation of $\pm \pi/2$. Unfortunately, directionality is not obvious in this depiction, so we need to improve graphics before we can check anything.

The new directions are drawn on top of a grid,

Graphics[{Opacity[0], EdgeForm[Thick],
  Polygon[star2], Polygon[star], Polygon[star2/2],
  Function[{or}, Polygon[or + #/2 & /@ star2]] /@ star,
  Function[{or}, Polygon[or + #/2 & /@ star2]] /@ star2,
  Function[{or}, Polygon[or + #/2 & /@ star]] /@ star,
  Opacity[1], PointSize -> Large, Red,
  Point /@ (star/2), Point /@ (star/2 + star2/4),
  Green, Point /@ (star/2 + star2/4),
  Point /@ (star/2 + RotateRight[star2/4]),
  Blue, Point /@ (star/2 + star2/2),
  Point /@ (star/2 + RotateRight[star2/2])}]

grid

DepictTC[or_, dir_] := {White, EdgeForm[Thick],
  If[dir == 1, Darker@Gray, dir /. colRules],
  Polygon[2 or + # & /@ Flatten[Transpose[
      {star/2, star/2 + star2/4, star/2 + star2/4,
       star/2 + star2/4 + RotateLeft[star2/2]}], 1]],
  Gray, Polygon[2 or + # & /@ #] & /@ Transpose[{star/2 + star2/4,
     star/2 + star2/2, star2,
     star/2 + star2/2 + RotateLeft[star2/2],
     star/2 + star2/4 + RotateLeft[star2/2]}],
  If[dir == 1, {}, Transpose[{Part[RotateRight[{2, 3, 4, 5}, 2],
       Complement[ Range[4], {RotateLeft[{1, 2, 3, 4}, dir - 2][[1]]}]] /. colRules,
     Function[{or2}, Polygon[2 or + or2 + #/2 & /@ star]] /@ star[[ 
        Complement[ Range[4], {RotateLeft[{1, 2, 3, 4}, dir - 2][[1]]}]  
        ]]}]]}

GraphicsRow[ Graphics[DepictTC[{0, 0}, #], PlotRange -> {{-2, 2}, {-2, 2}}, 
    ImageSize -> 100] & /@ Range[5]]

TC tiles

Now it is more obvious that rotation by $\pi/2$ acts as permutation of colors. According to bumps and nicks, we also have made join rules slightly more obvious. For example, black can not join black. Also note that colors here do not really matter, because tiles have fixed orientations. Our five target images are then depicted as

GraphicsGrid[{
  Graphics[{EdgeForm[Thick], # /. T -> Depict}, ImageSize -> 150, 
     PlotRange -> {{-2, 2} + {1/2, 1/2}, {-2, 2} + {1/2, 1/2}}] & /@  CenterTiles,
  Graphics[{EdgeForm[Thick], # /. T -> DepictTC}, ImageSize -> 150, 
     PlotRange -> {2 {-2, 2}, 2 {-2, 2}}] & /@   CenterTiles}]

inflation

And three characteristic pre-images are

GraphicsGrid[{
  Graphics[{EdgeForm[Thick], # /. T -> Depict}, ImageSize -> 150, 
     PlotRange -> {{-2, 2} + {1/2, 1/2}, {-2, 2} + {1/2, 1/2}}] & /@ 
   TwoAtlas0[[{1, 5, 15}]],
  Graphics[{EdgeForm[Thick], # /. T -> DepictTC}, ImageSize -> 150, 
     PlotRange -> {2 {-2, 2}, 2 {-2, 2}}] & /@ 
   TwoAtlas0[[{1, 5, 15}]]}]

pre22

For the first case, we wrongly assume green neighbor to south, follow logical deductions, apply reflection symmetry, and finally complete with one extra black:

case 1

In this graphical shorthand notation, circle-x's indicate placements forbidden by the corner rule, while red circles stand for "therefore". The second case is slightly easier:

case2

However, in the final completion we have ignored an equally valid pink-black-pink configuration for the top row. This is the notorious fault line issue, where it is legal to off-shift symmetry across an infinite line of trilobites, in this case yellow. To prove that fault lines must be infinitely long, we need one an alternating induction with two clauses:

fault line

Thus to maintain asymmetry, the yellow line must extend indefinitely to the left. The third omitted case has a similar nuance, as should now be obvious. Logic for other seventeen cases can be written programmatically by applying symmetry transforms.

To recap: If the $2 \times 2$ template has two black tiles, it maps uniquely to the black supertile. If the $2 \times 2$ template has only one black, it maps uniquely to the supertile of whichever colored tile occurs twice. Because these unique completions exist, we can use the five special $3 \times 3$ templates as supertiles. Next we must prove that these supertiles close under inflation to $7 \times 7$ templates.

Edit: Nov. 9, 2:05 PM. Suggestion that the following code (could be expanded on) also proves unique completion:

TwoAtlasInds = Map[Position[Outer[Length@Intersection[#1, #2] &,
      TwoAtlas0 /. T[x_, y_] :> T[x - #, y], CenterTiles, 1], 4] &,
   {{0, 0}, {0, 1}, {1, 1}, {1, 0}}];

Length /@ TwoAtlasInds
Complement[Flatten[TwoAtlasInds[[All, All, 1]]], Range[20]]
TwoAtlasInds[[All, All, 2]]

Out[]= {5, 5, 5, 5}
Out[]= {}
Out[]= {{1, 2, 3, 4, 5}, {1, 2, 3, 4, 5}, {1, 2, 3, 5, 4}, {1, 2, 3,5, 4}}

Closure of Atlas under Inflation

Almost all the thinking is done, we now less than ten minutes of compute time on a personal lap top computer. This time is used to first check $(3 \times 3)^2 $ tiles overlap correctly, reducing to $ 3^4 - 4 \times 7 - 4 = 49$ unique tiles in each non-conflicted $7 \times 7$ template. Additional checks must be performed at four black vertices where four $3\times3$ templates meet at a corner, then we obtain a relatively small set of only $71$ templates.

ThreeByThree[code_, len_] := Union[Flatten[
   MapThread[
    CenterTiles[[#2]] /. T[or_, dir_] :> T[or + len #1, dir] &, 
    {Prepend[Join[star, star2], {0, 0}], code}]]]

(* about 7 minutes *)
AbsoluteTiming[CodesFirstPass = Select[Tuples[Range[5], 9],
      SameQ[Length@ThreeByThree[#, 2], 49] &];][[1]]/60

filter[codes_, offset_, CheckTiles_, diff_] := Select[codes,
   Function[{code}, SameQ[Min[Length[ Complement[
            ThreeByThree[code, 2] /. 
             T[or_, dir_] :> T[or + offset, dir], #]
           ] & /@ CheckTiles], 49 - diff]][#] &];

CodesSecondPass = 
  FoldList[filter[#1, #2, OffCenterBTiles, 9] &, CodesFirstPass, 
   Tuples[{1, -1}, 2]];

Length /@ CodesSecondPass

   Out[]={339, 201, 133, 87, 71}

SortedSecondPass = Function[{int}, 
    Select[CodesSecondPass[[-1]], Count[#[[-4 ;; -1]], 1] == int &]] /@
    Reverse[Range[0, 4]];

Length /@ SortedSecondPass
Function[{int},  Length@Select[templates[[-1, All, 1]], 
    Count[#[[-4 ;; -1]], 1] == int &]] /@ Reverse[Range[0, 4]]
diffs = %% - %
Total[%]

Out[]={5, 0, 16, 24, 26}
Out[]={5, 0, 4, 16, 24}
Out[]={0, 0, 12, 8, 2}
Out[]=22

GraphicsGrid[{Graphics[{EdgeForm[Black], 
      ThreeByThree[#, 2] /. T -> Depict}, ImageSize -> 200] & /@ 
   SortedSecondPass[[1]],
  Graphics[{EdgeForm[Black], ThreeByThree[#, 2] /. T -> DepictTC}, 
     ImageSize -> 200] & /@ SortedSecondPass[[1]]}]

SuperSuperTiles

We are very happy to find these exact $5$ super-super-tiles, and can complete closure by proving the remaining 22 cases are spurious. Fourteen are eliminated by extension of the corner matching rule, and eight more are ignored as valid but faulty. Examples of the two classes are given as:

dCodes = Select[CodesSecondPass[[-1]], ! 
     MemberQ[templates[[-1]], #[[2 ;; -1]] -> #[[1]]] & ];
Complement[#[[2 ;; -1]] -> #[[1]] & /@ 
  Complement[CodesSecondPass[[-1]], dCodes], templates[[-1]]]
Length[dCodes]

SignalError = Join[
  {1, _, _, _, _, #, _, #, _} & /@ Range[2, 5],
  {1, _, _, _, _, _, #, _, #} & /@ Range[2, 5],
  MapThread[{1, _, _, _, _, _, #1, _, #2} &, {
    Range[2, 5], RotateRight[Range[2, 5], 2]}],
  MapThread[{1, _, _, _, _, #1, _, #2, _} &, {
    Range[2, 5], RotateRight[Range[2, 5], 2]}]]

dCodes2 = DeleteCases[dCodes, Alternatives @@ SignalError]

GraphicsRow[ Show[#, ImageSize -> 
     400] & /@ {Graphics[{ThreeByThree[dCodes[[1]], 2] /. 
      T -> DepictTC,
     Red, Thickness[0.01], Arrowheads[0.05], Arrow[{{0, 0}, {4, 4}}], 
     Arrow[{{0, 0}, -{4, 4}}]}],
   Graphics[ThreeByThree[dCodes2[[1]], 2] /. T -> DepictTC]
   }]

more exceptions

When the crab tiles are given orientations, matching signals propagate across the red axis, meeting at a conflict in on the central crab, thus invalidating the configuration. A really great idea is to program the trivial cellular automaton, which propagates crab directionality through the $7 \times 7$ super-super-tile, arriving at a conflict after only two time steps. For now we are happy with inspection, and invite the reader to look through all $22$ exceptions if necessary.

The Induction

Not much is left to be said. Since the first two atlases are identical up to scale, we have checked the base case of an induction which proceeds to say that successively larger $n^{th}$ order supertiles are proven combinatorially equivalent to the basic set of five symbols. At each step of the iteration, this requires orienting on black corners from the $(n-1)^{th}$ atlas to obtain a special set of only $5$ from the total set of $49$ . This process reveals the hierarchical symmetry and limit-periodicity of the five-color pattern. $\square$

POSTED BY: Brad Klee

4 Replies

Sort By:

Brad Klee

Posted 3 years ago

For sake of completion, I went ahead and programmed the cellular automaton for propagation of directional symbols on the crab tiles. First, one of the error cases from above: The central vertical has green on opposing corners. Signals eventually reach a conflict on the central crab, which then turns red, indicating that the entire configuration is invalid. All legal configurations involve bi-directional signal propagation, but never reach a conflict. For example, using a two-stage approach, first computing trilobite directions, then computing crab directions, we animate that: which is then defined everywhere away from central axes. Values on central axes depend on central tile, which can take on any one of four valid directions.

POSTED BY: Brad Klee

Brad Klee

Posted 3 years ago

Here's another line or two of code that helps with automatic verification: Atlas1 = Union[Flatten[# /. ChairRep]] & /@ Atlas0; TwoAtlas1 = Union[Flatten[# /. ChairRep]] & /@ TwoAtlas0; Atlas1B = Union[ThreeByThree[#, 2]] & /@ Complement[Flatten[SortedSecondPass, 1], dCodes]; Length[Complement[Atlas1, Atlas1B]] Out[]=0 To make the induction more definite, I've also made some images of how it could play out: UniqueComp = {1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 5, 5, 3, 3, 4, 4, 4, 4, 5,5}; OffsetVec = Part[{{0, 0}, {0, 1}, {1, 1}, {1, 0}}, #] & /@ {1, 2, 4, 3, 3, 2, 4, 1, 3, 4, 3, 4, 2, 1, 3, 2, 4, 1, 2, 1}; T0 = RandomSample[Atlas0[[1 ;; 5]]][[1]]; T1 = RandomSample[ Select[TwoAtlas1, Length@Intersection[#, T0] == 9 &]][[1]]; UTID = Position[TwoAtlas1, T1][[1, 1]]; T1b = Atlas1[[UniqueComp[[UTID]]]] /. T[or_, dir_] :> T[or + 2 OffsetVec[[UTID]], dir]; row = Show[#, ImageSize -> 200, PlotRange -> {{-6, 9}, {-6, 9}}] & /@ {Graphics[{Gray, Outer[Disk[{2 #1, 2 #2} - {1/2, 1/2}, 1/3] &, Range[-2, 4], Range[-2, 4], 1], T0} /. T -> Depict], Graphics[{Gray, Outer[Disk[{2 #1, 2 #2} - {1/2, 1/2}, 1/3] &, Range[-2, 4], Range[-2, 4], 1], T1} /. T -> Depict], Graphics[{Gray, Outer[Disk[{2 #1, 2 #2} - {1/2, 1/2}, 1/3] &, Range[-2, 4], Range[-2, 4], 1], Flatten@ Outer[Disk[{4 #1, 4 #2} - {1/2, 1/2} - {1, 1} + 2 OffsetVec[[UTID]], 2/3] &, Range[-3, 3], Range[-3, 3], 1], T1b} /. T -> Depict]} or or Random choose initial tile, random choose valid $2 \times 2$ completion, unique complete to $3\times3$, add second periodic lattice for supertile corners. Deflate and repeat ad infinitum.

Here's another line or two of code that helps with automatic verification:

Atlas1 = Union[Flatten[# /. ChairRep]] & /@ Atlas0;
TwoAtlas1 = Union[Flatten[# /. ChairRep]] & /@ TwoAtlas0;
Atlas1B = Union[ThreeByThree[#, 2]] & /@ 
   Complement[Flatten[SortedSecondPass, 1], dCodes];
Length[Complement[Atlas1, Atlas1B]]

Out[]=0

To make the induction more definite, I've also made some images of how it could play out:

UniqueComp = {1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 5, 5, 3, 3, 4, 4, 4, 4, 5,5};
OffsetVec =   Part[{{0, 0}, {0, 1}, {1, 1}, {1, 0}}, #] & /@ {1, 2, 4, 3, 3, 2, 4,
     1, 3, 4, 3, 4, 2, 1, 3, 2, 4, 1, 2, 1};
T0 = RandomSample[Atlas0[[1 ;; 5]]][[1]];
T1 = RandomSample[ Select[TwoAtlas1, Length@Intersection[#, T0] == 9 &]][[1]];
UTID = Position[TwoAtlas1, T1][[1, 1]];
T1b = Atlas1[[UniqueComp[[UTID]]]] /. 
   T[or_, dir_] :> T[or + 2 OffsetVec[[UTID]], dir];

row = Show[#, ImageSize -> 200, 
    PlotRange -> {{-6, 9}, {-6, 9}}] & /@ {Graphics[{Gray, 
      Outer[Disk[{2 #1, 2 #2} - {1/2, 1/2}, 1/3] &, Range[-2, 4], 
       Range[-2, 4], 1], T0} /. T -> Depict],
   Graphics[{Gray, 
      Outer[Disk[{2 #1, 2 #2} - {1/2, 1/2}, 1/3] &, Range[-2, 4], 
       Range[-2, 4], 1], T1} /. T -> Depict],
   Graphics[{Gray, 
      Outer[Disk[{2 #1, 2 #2} - {1/2, 1/2}, 1/3] &, Range[-2, 4], 
       Range[-2, 4], 1],
      Flatten@ Outer[Disk[{4 #1, 4 #2} - {1/2, 1/2} - {1, 1} + 
           2 OffsetVec[[UTID]], 2/3] &, Range[-3, 3], Range[-3, 3], 1],
      T1b} /. T -> Depict]}

rand row 1

rand row 2

rand row 3

Random choose initial tile, random choose valid $2 \times 2$ completion, unique complete to $3\times3$, add second periodic lattice for supertile corners. Deflate and repeat ad infinitum.

POSTED BY: Brad Klee

EDITORIAL BOARD

EDITORIAL BOARD, WOLFRAM

Posted 3 years ago

-- you have earned *Featured Contributor Badge* Your exceptional post has been selected for our editorial column *Staff Picks* http://wolfr.am/StaffPicks and Your Profile is now distinguished by a *Featured Contributor Badge* and is displayed on the Featured Contributor Board. Thank you!

POSTED BY: EDITORIAL BOARD

Brad Klee

Posted 3 years ago

Hi, Thanks again for the Plaudits! This is what a Moderation Team should do to make happy contributors, no doubt there. Yet we must not let the fame and success go immediately to our heads by minting NFT [GIF]s like crazy, because the "proof" (if it is that) needs to be checked and checked again. Presently, since it's just posted on a message board somewhere, it might be wrong. Personally, I'm not 100% confident, but getting there. I invite any criticism whatsoever about parts of the proof that don't make sense to readers. Verifying partial completion is very important, so here is a little more code showing exactly what happens for the entire atlas: CenterInds = Flatten[Position[Atlas0, #] & /@ CenterTiles]; ThreeCompletions = Position[#, 4] & /@ Outer[ Length@Intersection[#1 /. T[x_, y_] :> T[x - #3, y], #2] &, TwoAtlas0, Atlas0, {{0, 0}, {0, 1}, {1, 1}, {1, 0}}, 1]; CheckUniqueCompletion[CompletionVectors_] := With[ {hit = Cases[CompletionVectors, {Alternatives @@ CenterInds, x_}]}, And[Length[hit] == 1, Count[CompletionVectors[[All, 2]], hit[[1, 2]] ] == 1] -> hit[[1]]] CheckUniqueCompletion /@ ThreeCompletions And @@ Part[%, All, 1] -> Transpose[Part[%, All, 2]] {True -> {1, 1}, True -> {1, 2}, True -> {1, 4}, True -> {1, 3}, True -> {2, 3}, True -> {2, 2}, True -> {2, 4}, True -> {2, 1}, True -> {3, 3}, True -> {3, 4}, True -> {5, 3}, True -> {5, 4}, True -> {3, 2}, True -> {3, 1}, True -> {4, 3}, True -> {4, 2}, True -> {4, 4}, True -> {4, 1}, True -> {5, 2}, True -> {5, 1}} True -> {{1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 5, 5, 3, 3, 4, 4, 4, 4, 5, 5}, {1, 2, 4, 3, 3, 2, 4, 1, 3, 4, 3, 4, 2, 1, 3, 2, 4, 1, 2, 1}} Once the proofs are done, then maybe we can start talking about NFTs, but hopefully we don't need lawyers involved. Sales prices for the first official Wolfram auction are listed online: Total[{4000, 4901, 5001, 4001, 4400, 4000, 5500, 6290, 4397, 5000}] (* ADA to $$ )2.26%>10^5 Out[]=True Collectors are willing to pay to get their names on the ledger, and it really isn't that different than what Chinese collectors have done with ink seals. However, if the marketplace is to be a fair one, it can't just be filled with celebrities proving the rich get richer theory of recentralizing crypto. Collectors must be willing to pay a higher price if they want to associate with original proofs. Could speculate that if the market was working correctly, my recent spate of tilings animations (perhaps with a little more effort put into skins) would have a cosign value of $2^8$ KADA or other's prices should come back down to the reality everyone else is living in.

POSTED BY: Brad Klee

Group Abstract

Feedback