Brad’s code
Brad’s code
In[]:=
ArrayPlot[ResourceFunction["BlockCellularAutomaton"][{{1,1}->{2,0},{1,2}->{2,1},{2,0}->{1,1},{2,1}->{1,2},{0,0}->{0,0},{0,2}->{0,2},{1,0}->{1,0},{2,2}->{2,2},{0,1}->{1,1}},CenterArray[{2,2},1000],500],ImageSize->300,ColorRules->{0->White,1->Lighter[Orange],2->Darker[Orange]}]
Out[]=
depth=10000;AbsoluteTiming[data=ResourceFunction["BlockCellularAutomaton"][{{1,1}->{2,0},{1,2}->{2,1},{2,0}->{1,1},{2,1}->{1,2},{0,0}->{0,0},{0,2}->{0,2},{1,0}->{1,0},{2,2}->{2,2},{0,1}->{1,1}},CenterArray[{2,2},2*depth],depth];]
Out[]=
{105.629,Null}
AbsoluteTiming[seq=MapIndexed[If[MatchQ[#1,{__,1,1,1,1,0..}],#2[[1]],Nothing]&,data];]diff1=Differences[seq]diff2=Differences[diff1]
In[]:=
(diff1[[3;;-1]]-2)/3ListPlot[%]
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}
Out[]=
In[]:=
ListPlot[Prime[#]&/@Range[40]]
Out[]=
In[]:=
diff2[[3;;-1]]/3ListPlot[%]
Out[]=
{1,2,1,4,1,2,2,3,6,1,1,2,3,4,5,4,1,1,1,2,4,2,2,11,1,2,10,2,1,9,1,1,1,6,4,1,6,2,5,6,2,1,6}
Out[]=
alternative data
alternative data
In[]:=
depth=10000;AbsoluteTiming[data=ResourceFunction["BlockCellularAutomaton"][{{1,1}->{2,0},{1,2}->{2,1},{2,0}->{1,1},{2,1}->{1,2},{0,0}->{0,0},{0,2}->{0,2},{1,0}->{1,0},{2,2}->{2,2},{0,1}->{1,1}},CenterArray[{2,1,2},2*depth],depth];]
Out[]=
{100.952,Null}
In[]:=
AbsoluteTiming[seq=MapIndexed[If[MatchQ[#1,{__,1,1,1,1,0..}],#2[[1]],Nothing]&,data];]diff1=Differences[seq]diff2=Differences[diff1]
Out[]=
{70.322,Null}
Out[]=
{6,3,5,18,11,11,14,29,38,68,71,92,98,107,110,113,116,128,131,143,155,158,170,173,179,182,194,197,206,218,224,245,248,254,263,275,278,293,296,317,338,347,350,362,371,374,377,383,392,413,434}
Out[]=
{-3,2,13,-7,0,3,15,9,30,3,21,6,9,3,3,3,12,3,12,12,3,12,3,6,3,12,3,9,12,6,21,3,6,9,12,3,15,3,21,21,9,3,12,9,3,3,6,9,21,21}
In[]:=
(diff1[[3;;-1]]-2)/3ListPlot[%]
Out[]=
1,,3,3,4,9,12,22,23,30,32,35,36,37,38,42,43,47,51,52,56,57,59,60,64,65,68,72,74,81,82,84,87,91,92,97,98,105,112,115,116,120,123,124,125,127,130,137,144
16
3
Out[]=
In[]:=
ListPlot[Prime[#]&/@Range[40]]
Out[]=
In[]:=
diff2[[3;;-1]]/3ListPlot[%]
Out[]=
,-,0,1,5,3,10,1,7,2,3,1,1,1,4,1,4,4,1,4,1,2,1,4,1,3,4,2,7,1,2,3,4,1,5,1,7,7,3,1,4,3,1,1,2,3,7,7
13
3
7
3
Out[]=
More:
More:
Different initial condition