Sometime last year while we were working on a blog post about the Second Law, Stephen Wolfram and I happened to find a block cellular automaton reminiscent of the primes computer from NKS. The rules are:
In[]:=
primeLikeBCARules=Association[{​​{0,0}->{0,0},{0,1}->{1,1},{0,2}->{0,2},​​{1,0}->{1,0},{1,1}->{2,0},{1,2}->{2,1},​​{2,0}->{1,1},{2,1}->{1,2},{2,2}->{2,2}​​}];
The evolution of these rules can be followed through time using a cloud resource from the function repository, WFR`BlockCellularAutomaton. Here’s an evolution using one initial condition we found:
In[]:=
FilterColumns[mat_?MatrixQ,sym_:0​​]:=Transpose[DeleteCases[Transpose[mat],{0..}]]
In[]:=
ArrayPlot[FilterColumns[Map[First,​​ResourceFunction["BlockCellularAutomaton"][​​primeLikeBCARules,{CenterArray[{2,2},400],0},200]]],​​ImageSize->600,ColorRules->{0->White,1->Lighter[Orange],2->Darker[Orange]}]
Out[]=
Stephen asked to extract an integer sequence associated with the spacing of the diagonal white lines, but their being interrupted by the diagonal orange lines interfered with progress (anyone else want to try?). A new discovery was made by observing hypotenuses on the right external edge were again growing in a prime-like sequence. This is all conjectural, but you can see at the top of each hypotenuse a run of four 1’s into the surrounding blank space. We can generate and store the data up to about 10,000 time steps:
In[]:=
AbsoluteTiming[data=Map[First,​​ResourceFunction["BlockCellularAutomaton"][Association[{​​{0,0}->{0,0},{0,1}->{1,1},{0,2}->{0,2},​​{1,0}->{1,0},{1,1}->{2,0},{1,2}->{2,1},​​{2,0}->{1,1},{2,1}->{1,2},{2,2}->{2,2}}],​​{CenterArray[{2,2},2#],0},#]]&@10000;]
Out[]=
{40.953,Null}
Unfortunately, the function is still slow at least from not being compiled, so we could also try iconizing the data, but it’s just too large:
In[]:=
ByteCount[data]
Out[]=
4801040288
Instead, let’s just redact for the sequence of row spacings where we hope to find something interesting:
AbsoluteTiming[​​redacted=MapIndexed[If[MatchQ[#1,​​{__,1,1,1,1,0..}],​​#2[[1]],Nothing]&,data];​​]
Out[]=
{81.8958,Null}
The redacted data doesn’t even need to be iconized, it can be written down in a short list (more terms anyone?):
In[]:=
redacted
Out[]=
{6,15,81,125,172,225,281,349,420,497,580,672,782,895,1011,1133,1264,1407,1565,1735,1908,2084,2263,2448,2645,2848,3057,3299,3544,3795,4076,4363,4653,4970,5290,5613,5939,6283,6639,6998,7375,7758,8156,8572,8994,9419,9862}
In[]:=
Differences[redacted]
Out[]=
{9,66,44,47,53,56,68,71,77,83,92,110,113,116,122,131,143,158,170,173,176,179,185,197,203,209,242,245,251,281,287,290,317,320,323,326,344,356,359,377,383,398,416,422,425,443}
A list plot of the first differences looks considerably similar to the primes:
In[]:=
Row[Show[#,ImageSize->300]&/@{ListPlot[Differences[redacted]],​​ListPlot[Prime/@Range[40]]},Spacer[10]]
Out[]=
0
10
20
30
40
100
200
300
400
0
10
20
30
40
50
100
150
Though, obviously they are not exactly the same. There seems also to be a hidden factor of three, which can be removed as follows, and we get simplified prime-like output:
In[]:=
primeLikeSeq=(Differences[redacted][[3;;-1]]-2)/3
Out[]=
{14,15,17,18,22,23,25,27,30,36,37,38,40,43,47,52,56,57,58,59,61,65,67,69,80,81,83,93,95,96,105,106,107,108,114,118,119,125,127,132,138,140,141,147}
For one reason or another, Stephen was not interested in promoting this sequence. I’m not an expert about the primes, so I decided just to leave this calculation in the archives.
Recently on [seqfans] mailing list, Neil Sloane asked a question about the "Gilbreath Mysteries", which predictably caught my attention, and perhaps unpredictably revived my interest in our previous computation. The Gilbreath transform can be applied as follows:
In[]:=
Map[First,FixedPointList[Abs@*Differences,redacted][[1;;-3]]]
Out[]=
{6,9,57,35,16,0,16,6,4,6,1,6,2,2,1,0,2,0,2,0,2,1,0,2,1,0,2,0,1,1,1,1,1,0,2,1,0,1,1,1,0,2,1,1,1,1,1}
In[]:=
Map[First,FixedPointList[Abs@*Differences,primeLikeSeq][[1;;-3]]]
Out[]=
{14,1,1,0,2,0,0,1,0,1,0,1,0,1,0,0,0,0,1,0,1,1,0,1,0,1,1,0,0,0,1,1,1,0,0,1,0,1,1,1,1,0,0,0}
Again, conjecturally, the sequence seems mostly made of ones and zeroes, possibly with some larger values around the start (and also recurring twos if not dividing by three). In point 5 of Neil’s email, he suggested other prime-like sequences might also show the constant behavior of the Gilbreath transform applied to the primes:
In[]:=
Map[First,FixedPointList[Abs@*Differences,Prime/@Range[40]][[1;;-3]]]
Out[]=
{2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1}
However, one counter example, the lucky numbers, were shown to have an irregular pattern of interspersed zeroes and twos. So perhaps what we’re seeing here is the perfection of the primes, relative to other sets which show something like broken symmetry in their irregular alternations. I don’t honestly know, it’s one of those math questions way outside of my limited expertise.

CITE THIS NOTEBOOK

Another example of the "Gilbreath Mysteries”​
by Brad Klee​
Wolfram Community, STAFF PICKS, May 11 2023
​https://community.wolfram.com/groups/-/m/t/2918701