Message Boards Message Boards

Note on NKS ch.5 sec.7: Systems Based on Constraints

Brad Klee, Wolfram Research
Posted 3 years ago

enter image description here

Brute force searches using overlapping constraint templates, as described in Chapter 5 Section 7 of NKS have been surprisingly unsuccessful at finding hierarchical aperiodic patterns; although, one known example is mentioned in the extensive notes. Much more can be done simply by examining preexisting results. Every edge-matching tiling over $\mathbb{Z}^2$ must have a definition in terms of overlapping templates. Such a definition can be obtained simply by listing all possible matching configurations in what is called an Atlas. The purpose of this memo is to obtain and analyze the $3 \times 3$ Atlas for the Trilobite and Crab tiling (a very simple limit-periodic pattern, which we mentioned in the previous post on Static Plane Filling Cellular Automata).

What we are missing so far is a definition of Trilobite and Crab as a substitution system. Producing the correct codified replacement rules is the most difficult part of this entire analysis. Here they are anyways (in a good-enough form, but sort of hacked):

    RRule = Join[{
        T[x0_, mc, h_, v_] :> {
          T[2 x0, mc, h, v],
          T[2 x0 + {1, 0}, oc, h, 1],
          T[2 x0 + {0, 1}, oc, 1, v],
          T[2 x0 - {1, 0}, oc, h, 0],
          T[2 x0 - {0, 1}, oc, 0, v],
          T[2 x0 + {1, 1}, t, 0],
          T[2 x0 + {-1, 1}, t, 1],
          T[2 x0 + {-1, -1}, t, 2],
          T[2 x0 + {1, -1}, t, 3]},

        (* don't need trilobites here *)
        T[x0_, oc, h_, v_] :> {
          T[2 x0, mc, h, v],
          T[2 x0 + {1, 0}, oc, h, 0],
          T[2 x0 + {0, 1}, oc, 0, v],
          T[2 x0 - {1, 0}, oc, h, 1],
          T[2 x0 - {0, 1}, oc, 1, v]}
        },
       (* don't need crabs here *)
       MapThread[
        T[x0_, t, #1] :> {
           T[2 x0, t, #1],
           T[2 x0 + RotateLeft[
               {{1, 1}, {-1, 1}, {-1, -1}, {1, -1}}, #1][[1]], t, #1],
           T[2 x0 + RotateLeft[
               {{1, 1}, {-1, 1}, {-1, -1}, {1, -1}}, #1][[2]], t, #3],
           T[2 x0 + RotateLeft[
               {{1, 1}, {-1, 1}, {-1, -1}, {1, -1}}, #1][[3]], t, #1],
           T[2 x0 + RotateLeft[
               {{1, 1}, {-1, 1}, {-1, -1}, {1, -1}}, #1][[4]], t, #2]
           } &, {{0, 1, 2, 3}, {1, 2, 3, 0}, {3, 0, 1, 2}}]];

Since there are a total of twelve tiles in play--two crabs and one trilobite, each in four orientations--we will use three colors plus monomino markings as seen in Troika, "Reality is not always Probable". The depiction functions are as follows:

Monomino[v0_, 0] := {Black, Disk[v0, 1/8]}
Monomino[v0_, 1] := {Black, Disk[v0 + {1/4, 1/4}, 1/8], 
  Disk[v0 - {1/4, 1/4}, 1/8]}
Monomino[v0_, 2] := {Black, Disk[v0, 1/8], 
  Disk[v0 + {1/4, -1/4}, 1/8], Disk[v0 - {1/4, -1/4}, 1/8]}
Monomino[v0_, 3] := {Black, Disk[v0 + {1/4, 1/4}, 1/8], 
  Disk[v0 - {1/4, 1/4}, 1/8],
  Disk[v0 + {1/4, -1/4}, 1/8], Disk[v0 - {1/4, -1/4}, 1/8]}

ColRules = {
   T[x_, t, r_] :> {Lighter@RGBColor[1, 0, 0], 
     Rectangle[x - {1/2, 1/2}], Monomino[x, r]},
   T[x_, oc, b1_, b2_] :> {Lighter@RGBColor[0, 1, 0], 
     Rectangle[x - {1/2, 1/2}], Monomino[x, Mod[2 b1 + b2, 4]]},
   T[x_, mc, b1_, b2_] :> {Lighter@RGBColor[0, 0, 1], 
     Rectangle[x - {1/2, 1/2}], Monomino[x, Mod[2 b1 + b2, 4]]}
   };

ColRules2 = {
   T[x_, t, r_] :> {Lighter@RGBColor[1, 0, 0], 
     Rectangle[x - {1/2, 1/2}], Monomino[x, r]},
   T[x_, oc, r_] :> {Lighter@RGBColor[0, 1, 0], 
     Rectangle[x - {1/2, 1/2}], Monomino[x, r]},
   T[x_, mc, r_] :> {Lighter@RGBColor[0, 0, 1], 
     Rectangle[x - {1/2, 1/2}], Monomino[x, r]}
   };

ColRules3 = {
   T[x_, t, 
     r_] :> {Switch[r, 0, Hue[(2 - 1)/8], 1, Hue[(2 2 - 1)/8], 2,
      Lighter@Hue[(2 3 - 1)/8], 3, Lighter@Hue[(2 4 - 1)/8]], 
     Rectangle[x]},
   T[x_, oc, b1_, b2_] :> {RGBColor[0, 0, 0], Rectangle[x]},
   T[x_, mc, b1_, b2_] :> {RGBColor[0, 0, 0], Rectangle[x]}
   };

dat = Union[Flatten[T[{0, 0}, mc, 0, 0] /. RRule /. RRule /. RRule]];
Row[Show[#, ImageSize -> 500] & /@ {Graphics[dat /. ColRules], 
   Graphics[dat /. ColRules3]}]

RGB monomino pattern

For comparison to our previous animation, we project all green and blue tiles to black on the right. As long as the trilobite orientations are known, the crab orientations can be recovered, after propagation from a distance, by noting orientation of trilobites to direct north, south, east and west.

Now that we have the substitution system working, we just need to blow up the pattern large enough to notice every possible configuration:

ToNum = {T[x_, t, r_] :> r,
   T[x_, oc, b1_, b2_] :> 4 + 2 b1 + b2,
   T[x_, mc, b1_, b2_] :> 8 + 2 b1 + b2};

GetBlocks[dat_] := With[{cents = dat[[All, 1]]},
  dat[[#]] /. ToNum & /@ (Select[
     Flatten /@ 
      DeleteCases[Outer[Flatten[Position[cents, #1 + #2]] &,
        cents, {{0, 0}, {1, 0}, {0, 1}, {-1, 0}, {0, -1}, {1, 1}, {-1,
           1}, {-1, -1}, {1, -1}}, 1],
       {}, Infinity], Length[#] == 9 &])]

datSets = NestList[Union[Flatten[# /. RRule]] &, T[{0, 0}, mc, 0, 0], 6];

AbsoluteTiming[
 AllBlocks = GetBlocks[#] & /@ datSets[[2 ;; -1]];
 ]

Length /@ AllBlocks
Length[Union[#]] & /@ AllBlocks

Out[]:= {1, 13, 85, 421, 1861, 7813}
Out[]:= {1, 13, 75, 144, 156, 156}

This code could be a little more elegant, but apparently it gets the job done. We obtain a set of 156 $3\times3$ templates. Due to sublattice symmetry, this count is far too many. We can reduce to only $32$ in $8$ groups of $4$:

ReducedAtlas = Cases[Union[AllBlocks[[-1]]], {_, _, _, _, _, 0 | 1 | 2 | 3, 
   0 | 1 | 2 | 3, 0 | 1 | 2 | 3, 0 | 1 | 2 | 3}]

Out[332]= {
{0,5,6,6,5,0,3,0,1}, {1,7,7,4,4,2,1,0,1}, {2,5,6,6,5,2,3,2,1},
{3,7,7,4,4,2,3,0,3}, {8,4,4,5,6,1,0,1,0}, {8,4,4,5,6,1,0,3,0}, 
{8,4,4,5,6,1,0,3,2}, {8,4,4,5,6,3,0,1,0}, {8,4,4,5,6,3,0,3,0}, 
{8,4,4,5,6,3,2,1,0}, {8,5,6,4,4,0,1,2,3}, {9,4,5,5,7,1,0,1,0}, 
{9,4,5,5,7,1,0,1,2}, {9,4,5,5,7,1,0,3,2}, {9,4,5,5,7,1,2,1,0}, 
{9,4,5,5,7,1,2,1,2}, {9,4,5,5,7,3,2,1,0}, {9,5,7,4,5,0,1,2,3}, 
{10,6,4,7,6,1,0,3,2}, {10,6,4,7,6,3,0,3,0}, {10,6,4,7,6,3,0,3,2}, 
{10,6,4,7,6,3,2,1,0}, {10,6,4,7,6,3,2,3,0}, {10,6,4,7,6,3,2,3,2}, 
{10,7,6,6,4,0,1,2,3}, {11,6,5,7,7,1,0,3,2}, {11,6,5,7,7,1,2,1,2}, 
{11,6,5,7,7,1,2,3,2}, {11,6,5,7,7,3,2,1,0}, {11,6,5,7,7,3,2,1,2}, 
{11,6,5,7,7,3,2,3,2}, {11,7,7,6,5,0,1,2,3}}

Templates

The $3 \times 3$ templates are required to overlap on $1 \times 3$ edges, so we can even map blue to green and reduce $12$ colors to $8$. Perhaps a little more work could be done to prove that these set of $32$ (or $8$ in four rotational classes) indeed close under inflation, but we leave that task for another day.
POSTED BY: Brad Klee
3 Replies
Sort By:

After g.t. $20$ minutes, the computer finally produced the following graph, which counts new rules needed as a function of time: 

Length /@ ReducedCodeData2
Total[%]
ListPlot[%%]

Out[]= {4, 8, 8, 12, 0, 8, 20, 16, 0, 0, 0, 8, 0, 8, 16, 10, 0, 0, 0, 0, 0, 
0, 0, 8, 0, 0, 0, 0, 0, 24, 12, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 12, 0, 4, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}

Out[]=179

chair rule count

When running the C.A. a small time savings (l.t. factor 2) can be found by using only the 179 rules. For reference those 179 rules are printed off as: 

AllRules2

Out[156]=

 {
{0, 0, 0, 1, 0, 0, 0, 0} -> 3
{0, 0, 0, 3, 0, 0, 0, 0} -> 3
{0, 0, 0, 5, 0, 0, 0, 0} -> 5
{0, 0, 0, 5, 0, 0, 0, 1} -> 5
{0, 0, 0, 5, 0, 0, 1, 0} -> 5
{0, 0, 0, 5, 0, 1, 0, 0} -> 5
{0, 0, 0, 5, 0, 1, 0, 1} -> 5
{0, 0, 0, 5, 0, 1, 1, 0} -> 5
{0, 0, 0, 5, 1, 0, 0, 0} -> 5
{0, 0, 0, 5, 1, 0, 0, 1} -> 5
{0, 0, 0, 5, 1, 0, 1, 0} -> 5
{0, 0, 0, 5, 1, 1, 0, 0} -> 5
{0, 0, 0, 5, 1, 1, 0, 1} -> 5
{0, 0, 0, 5, 1, 1, 1, 0} -> 5
{0, 0, 1, 0, 0, 0, 0, 0} -> 2
{0, 0, 1, 2, 0, 0, 2, 0} -> 5
{0, 0, 1, 4, 0, 0, 4, 0} -> 5
{0, 0, 2, 0, 0, 0, 0, 0} -> 2
{0, 0, 3, 1, 0, 0, 3, 0} -> 4
{0, 0, 3, 2, 0, 0, 1, 0} -> 1
{0, 0, 3, 4, 0, 0, 3, 0} -> 1
{0, 0, 4, 0, 0, 0, 0, 0} -> 4
{0, 0, 4, 0, 0, 0, 0, 1} -> 4
{0, 0, 4, 0, 0, 0, 1, 0} -> 4
{0, 0, 4, 0, 0, 0, 1, 1} -> 4
{0, 0, 4, 0, 0, 1, 0, 0} -> 4
{0, 0, 4, 0, 0, 1, 0, 1} -> 4
{0, 0, 4, 0, 1, 0, 0, 0} -> 4
{0, 0, 4, 0, 1, 0, 0, 1} -> 4
{0, 0, 4, 0, 1, 0, 1, 0} -> 4
{0, 0, 4, 0, 1, 0, 1, 1} -> 4
{0, 0, 4, 0, 1, 1, 0, 0} -> 4
{0, 0, 4, 0, 1, 1, 0, 1} -> 4
{0, 0, 4, 5, 0, 0, 0, 0} -> 1
{0, 0, 4, 5, 0, 0, 1, 0} -> 1
{0, 0, 5, 1, 0, 0, 5, 0} -> 4
{0, 0, 5, 2, 0, 0, 2, 0} -> 1
{0, 0, 5, 4, 0, 0, 4, 0} -> 1
{0, 0, 5, 4, 0, 0, 4, 1} -> 1
{0, 0, 5, 4, 0, 0, 5, 0} -> 1
{0, 0, 5, 4, 0, 0, 5, 1} -> 1
{0, 0, 5, 4, 0, 1, 4, 0} -> 1
{0, 0, 5, 4, 0, 1, 5, 0} -> 1
{0, 0, 5, 4, 1, 0, 4, 0} -> 1
{0, 0, 5, 4, 1, 0, 5, 0} -> 1
{0, 1, 0, 0, 0, 0, 0, 0} -> 5
{0, 1, 1, 4, 0, 4, 4, 0} -> 5
{0, 1, 1, 5, 0, 4, 0, 0} -> 5
{0, 1, 3, 0, 0, 3, 0, 0} -> 4
{0, 1, 5, 0, 0, 5, 0, 0} -> 4
{0, 2, 1, 0, 0, 2, 0, 0} -> 3
{0, 2, 3, 0, 0, 2, 0, 0} -> 1
{0, 2, 5, 0, 0, 1, 0, 0} -> 1
{0, 3, 0, 0, 0, 0, 0, 0} -> 3
{0, 3, 0, 0, 0, 0, 0, 1} -> 3
{0, 3, 0, 0, 0, 0, 1, 0} -> 3
{0, 3, 0, 0, 0, 0, 1, 1} -> 3
{0, 3, 0, 0, 0, 1, 0, 0} -> 3
{0, 3, 0, 0, 0, 1, 0, 1} -> 3
{0, 3, 0, 0, 0, 1, 1, 0} -> 3
{0, 3, 0, 0, 0, 1, 1, 1} -> 3
{0, 3, 0, 0, 1, 0, 0, 0} -> 3
{0, 3, 0, 0, 1, 0, 0, 1} -> 3
{0, 3, 0, 0, 1, 0, 1, 0} -> 3
{0, 3, 0, 0, 1, 0, 1, 1} -> 3
{0, 3, 1, 1, 0, 0, 4, 0} -> 3
{0, 3, 4, 0, 0, 0, 0, 0} -> 1
{0, 3, 4, 0, 0, 1, 0, 0} -> 1
{0, 4, 1, 0, 0, 4, 0, 0} -> 3
{0, 4, 1, 1, 0, 4, 4, 0} -> 3
{0, 4, 3, 0, 0, 3, 0, 0} -> 1
{0, 4, 3, 0, 0, 3, 0, 1} -> 1
{0, 4, 3, 0, 0, 3, 1, 0} -> 1
{0, 4, 3, 0, 0, 4, 0, 0} -> 1
{0, 4, 3, 0, 0, 4, 0, 1} -> 1
{0, 4, 3, 0, 0, 4, 1, 0} -> 1
{0, 4, 3, 0, 1, 3, 0, 0} -> 1
{0, 4, 3, 0, 1, 4, 0, 0} -> 1
{0, 4, 5, 0, 0, 5, 0, 0} -> 1
{0, 5, 0, 0, 0, 0, 0, 0} -> 5
{1, 0, 0, 0, 0, 0, 0, 0} -> 4
{1, 0, 0, 2, 0, 0, 0, 2} -> 5
{1, 0, 0, 4, 0, 0, 0, 4} -> 5
{1, 0, 4, 1, 0, 0, 0, 5} -> 4
{1, 0, 5, 1, 0, 0, 5, 5} -> 4
{1, 1, 0, 2, 2, 0, 0, 2} -> 5
{1, 1, 0, 5, 2, 0, 0, 0} -> 5
{1, 1, 1, 2, 0, 4, 0, 2} -> 5
{1, 1, 1, 2, 2, 4, 0, 2} -> 5
{1, 1, 1, 4, 2, 0, 4, 0} -> 5
{1, 1, 1, 4, 2, 4, 4, 0} -> 5
{1, 1, 1, 5, 2, 4, 0, 0} -> 5
{1, 1, 3, 0, 3, 3, 0, 0} -> 4
{1, 1, 3, 1, 0, 3, 0, 5} -> 4
{1, 1, 3, 1, 3, 3, 0, 5} -> 4
{1, 1, 4, 0, 3, 0, 0, 0} -> 4
{1, 1, 4, 1, 3, 0, 0, 5} -> 4
{1, 1, 5, 1, 3, 0, 5, 0} -> 4
{1, 1, 5, 1, 3, 0, 5, 5} -> 4
{1, 2, 0, 0, 2, 0, 0, 0} -> 3
{1, 2, 0, 1, 2, 0, 0, 2} -> 3
{1, 2, 1, 1, 2, 0, 4, 0} -> 3
{1, 2, 1, 1, 2, 0, 4, 2} -> 3
{1, 3, 0, 1, 0, 0, 0, 2} -> 3
{1, 3, 1, 1, 0, 0, 4, 2} -> 3
{1, 4, 0, 0, 4, 0, 0, 0} -> 3
{1, 4, 1, 1, 0, 4, 0, 2} -> 3
{1, 4, 1, 1, 0, 4, 4, 2} -> 3
{2, 0, 0, 0, 0, 0, 0, 0} -> 2
{2, 0, 0, 0, 0, 0, 0, 1} -> 2
{2, 0, 0, 0, 0, 0, 1, 0} -> 2
{2, 0, 0, 0, 0, 0, 1, 1} -> 2
{2, 0, 0, 0, 0, 1, 0, 0} -> 2
{2, 0, 0, 0, 0, 1, 0, 1} -> 2
{2, 0, 0, 0, 0, 1, 1, 0} -> 2
{2, 0, 0, 0, 0, 1, 1, 1} -> 2
{2, 0, 0, 0, 1, 0, 0, 0} -> 2
{2, 0, 0, 0, 1, 0, 1, 0} -> 2
{2, 0, 0, 0, 1, 1, 0, 0} -> 2
{2, 0, 0, 0, 1, 1, 1, 0} -> 2
{2, 0, 0, 5, 0, 0, 0, 0} -> 1
{2, 0, 0, 5, 0, 0, 0, 1} -> 1
{2, 0, 1, 1, 0, 0, 5, 0} -> 2
{2, 1, 1, 0, 0, 3, 0, 0} -> 2
{2, 1, 1, 1, 0, 3, 5, 0} -> 2
{2, 3, 0, 0, 0, 0, 0, 0} -> 1
{2, 3, 0, 0, 1, 0, 0, 0} -> 1
{2, 3, 4, 5, 0, 0, 0, 0} -> 1
{2, 3, 4, 5, 0, 1, 0, 1} -> 1
{2, 3, 4, 5, 1, 0, 1, 0} -> 1
{3, 0, 0, 1, 0, 0, 0, 3} -> 2
{3, 0, 0, 2, 0, 0, 0, 3} -> 1
{3, 0, 0, 4, 0, 0, 0, 1} -> 1
{3, 1, 0, 0, 3, 0, 0, 0} -> 2
{3, 1, 1, 0, 3, 3, 0, 0} -> 2
{3, 1, 1, 1, 3, 0, 5, 0} -> 2
{3, 1, 1, 1, 3, 3, 5, 0} -> 2
{3, 2, 0, 0, 2, 0, 0, 0} -> 1
{3, 2, 0, 0, 2, 0, 0, 1} -> 1
{3, 2, 0, 0, 2, 0, 1, 0} -> 1
{3, 2, 0, 0, 2, 1, 0, 0} -> 1
{3, 2, 0, 0, 3, 0, 0, 0} -> 1
{3, 2, 0, 0, 3, 0, 0, 1} -> 1
{3, 2, 0, 0, 3, 0, 1, 0} -> 1
{3, 2, 0, 0, 3, 1, 0, 0} -> 1
{3, 2, 5, 4, 2, 0, 5, 0} -> 1
{3, 2, 5, 4, 2, 0, 5, 1} -> 1
{3, 2, 5, 4, 2, 1, 5, 0} -> 1
{3, 2, 5, 4, 2, 1, 5, 1} -> 1
{3, 2, 5, 4, 3, 0, 4, 0} -> 1
{3, 2, 5, 4, 3, 0, 4, 1} -> 1
{3, 2, 5, 4, 3, 1, 4, 0} -> 1
{3, 2, 5, 4, 3, 1, 4, 1} -> 1
{3, 4, 0, 0, 4, 0, 0, 0} -> 1
{4, 0, 0, 0, 0, 0, 0, 0} -> 4
{5, 0, 0, 1, 0, 0, 0, 5} -> 2
{5, 0, 0, 2, 0, 0, 0, 2} -> 1
{5, 0, 0, 2, 0, 0, 0, 5} -> 1
{5, 0, 0, 2, 0, 0, 1, 2} -> 1
{5, 0, 0, 2, 0, 0, 1, 5} -> 1
{5, 0, 0, 2, 0, 1, 0, 2} -> 1
{5, 0, 0, 2, 0, 1, 0, 5} -> 1
{5, 0, 0, 2, 1, 0, 0, 2} -> 1
{5, 0, 0, 2, 1, 0, 0, 5} -> 1
{5, 0, 0, 4, 0, 0, 0, 4} -> 1
{5, 0, 1, 1, 0, 0, 5, 5} -> 2
{5, 1, 0, 0, 5, 0, 0, 0} -> 2
{5, 1, 1, 1, 0, 3, 0, 5} -> 2
{5, 1, 1, 1, 0, 3, 5, 5} -> 2
{5, 2, 0, 0, 5, 0, 0, 0} -> 1
{5, 4, 0, 0, 1, 0, 0, 0} -> 1
{5, 4, 3, 2, 0, 3, 0, 2} -> 1
{5, 4, 3, 2, 0, 3, 1, 2} -> 1
{5, 4, 3, 2, 0, 4, 0, 5} -> 1
{5, 4, 3, 2, 0, 4, 1, 5} -> 1
{5, 4, 3, 2, 1, 3, 0, 2} -> 1
{5, 4, 3, 2, 1, 3, 1, 2} -> 1
{5, 4, 3, 2, 1, 4, 0, 5} -> 1
{5, 4, 3, 2, 1, 4, 1, 5} -> 1
}

As indicated by the graph above, we strongly suspect these are the only rules need to infinity.

POSTED BY: Brad Klee

Chair Atlas

Chair Atlas

The following code uses the atlas above to derive a rule set for growing the chair tiling as a cellular automaton. As with Half Hex and Whole Hex examples, some extra rules are needed to kickstart growth. In this case we also need to do a little pruning of "obvious" rules. 

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]

NeighborLocs[or_] := Map[Plus[or, #] &, Join[star, star2]]

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

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

templates = Union[GetTemplates[#]] & /@ InflateList[4];
Length /@ templates;

SortedInds = Cases[Position[templates[[-1]], #], {x_, 2} :> x] & /@ Range[1, 5];

partials[temp_] := ReplacePart[temp, Alternatives @@ # -> _] & /@ 
   Subsets[Range[Length[temp]]];

AllPartials = Union[Flatten[partials /@ templates[[-1, SortedInds[[#]], 1]], 
      1]] & /@ Range[5];

(*Only Grow From Colored vertices*)
exclude = Select[Flatten[AllPartials, 1], 
   Plus[Count[#[[1 ;; 4]], 2], Count[#[[1 ;; 4]], 3],
      Count[#[[1 ;; 4]], 4], Count[#[[1 ;; 4]], 5]] == 0 &];

FilteredPartials = Complement[AllPartials[[#]],
     Join[Flatten[AllPartials[[Complement[Range[5], {#}]]] , 1], 
      exclude] ] & /@ Range[5];

DefiniteRules = Map[Alternatives @@ FilteredPartials[[#]] -> # &, Range[5]];

StraightRulesB = Join[
   Map[Join[RotateRight[{0, 0, 0, 1}, # + 1], {0, 0, 0, 0}] -> # &, Range[2, 5]],
   Map[Join[ RotateRight[{0, 0, 0, #}, # + 1], 
          {1 | 0, 0 | 1, 0 | 1, 1 | 0}] -> # &, Range[2, 5]],
   Map[Join[ RotateRight[{0, #, 0, 0}, # + 1], {1 | 0, 0 | 1, 0 | 1, 
        1 | 0}] -> # &, Range[2, 5]] ];

AllRules = Join[StraightRulesB, DefiniteRules];

State0 = {Axiom[templates[[-1, -2]]], {}};

Iterate[state_] := With[{newVerts = Complement[
     Flatten[NeighborLocs[#] & /@ state[[1, All, 1]], 1],
     Flatten[state[[All, All, 1]], 1]]},
  Flatten /@ {MapThread[If[IntegerQ[#2], T[#1, #2], {}] &,
     {newVerts, ReplaceAll[NeighborVals[Flatten[state], #],
         AllRules] & /@ newVerts}], state}]

GrowList[n_] := NestList[Iterate, {{T[{0, 0}, 1]}, {}}, n]

Complement[InflateList[4][[-1]], Flatten[GrowList[2^(4 + 1)][[-1]]]]
Out[]={}

AbsoluteTiming[dat = Length /@ GrowList[2^6][[All, 1]]]
dat[[2 ;; -1]]/4
Flatten[Position[%, 3]]
Differences[%]

Out[]={1, 4, 8, 12, 16, 12, 20, 36, 36, 12, 20, 36, 44, 36, 60, 
  108, 84, 12, 20, 36, 44, 36, 60, 108, 100, 36, 60, 108, 132, 108, 
  180, 324, 204, 12, 20, 36, 44, 36, 60, 108, 100, 36, 60, 108, 132, 
  108, 180, 324, 236, 36, 60, 108, 132, 108, 180, 324, 300, 108, 180, 
  324, 396, 324, 540, 972, 516}

Out[]={1, 2, 3, 4, 3, 5, 9, 9, 3, 5, 9, 11, 9, 15, 27, 21, 3, 5, 9, 11, 9, 
15, 27, 25, 9, 15, 27, 33, 27, 45, 81, 51, 3, 5, 9, 11, 9, 15, 27, 
25, 9, 15, 27, 33, 27, 45, 81, 59, 9, 15, 27, 33, 27, 45, 81, 75, 27, 
45, 81, 99, 81, 135, 243, 129}

Out[]={3, 5, 9, 17, 33}

Out[]={2, 4, 8, 16}

As in the other cases, numeric outputs show log periodicity and Ulam Structure. Later we may also run some timing tests to see if we can speed up calculation of terms. For now we are happy with what we have.

POSTED BY: Brad Klee

enter image description here -- you have earned Featured Contributor Badge enter image description here 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

Group Abstract Group Abstract