Message Boards Message Boards

Computable proof of Trilobite and Crab

Posted 3 years ago
POSTED BY: Brad Klee
4 Replies
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:

error case

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:

almost complete region

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
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]}

rand row 1

or

rand row 2

or

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

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
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 Group Abstract