Analysis of Black and White Cells in the Center Column of Rule 30
Author
Xiangdong Wen
Title
Analysis of Black and White Cells in the Center Column of Rule 30
Description
Plots showing the accumulated differences of the number of black and white cells in the center column of rule 30.
Category
Essays, Posts & Presentations
Keywords
URL
http://www.notebookarchive.org/2019-09-dtysya8/
DOI
https://notebookarchive.org/2019-09-dtysya8
Date Added
2019-09-30
Date Last Modified
2019-09-30
File Size
6.65 megabytes
Supplements
Rights
Redistribution rights reserved
Download
Open in Wolfram Cloud
Analysis of Black and White Cells in the Center Column of Rule 30
Analysis of Black and White Cells in the Center Column of Rule 30
Plots showing the accumulated differences of the number of black and white cells in the center column of rule 30.
Initialize Data
Initialize Data
The first 1 billion bits of the center column of rule 30 are stored as a ByteArray CloudObject. The following code gets the object exactly to 1 billion elements, and calculates the accumulated number of differences of black and white cells.
In[]:=
acc=Accumulate[2*Flatten[IntegerDigits[#,2,8]&/@Normal[CloudGet[CloudObject["https://www.wolframcloud.com/obj/92a0b42d-831e-4b5a-afb1-4f13e28d0787"]]]]-1];
Histograms
Histograms
We can ask if it’s approximating a random walk. Here, histograms show the distribution of how far the walk gets from 0 after different numbers of steps.
Make a Histogram for a million steps:
In[]:=
Histogram[Take[acc,10^6]]
Out[]=
For 10 million steps:
Histogram[Take[acc,10^7]]
Out[]=
For 100 million steps:
Histogram[Take[acc,10^8]]
Out[]=
For a billion steps:
Histogram[acc]
Out[]=
Minimum, Maximum Differences of Black and White Cells
Minimum, Maximum Differences of Black and White Cells
We can find the minimum difference and its positions.
The minimum difference is:
In[]:=
Min[acc]
Out[]=
-257
Which happens only at these positions:
In[]:=
Position[acc,-257]
Out[]=
{{172711},{172735}}
We can see that in a ListLinePlot, the lines representing maximum differences of black over white cells never converge (at least up to a billion steps!)
Use FunctionCompile to set up a definition for “max” to compute current maximum values of the list so far (this way we automatically save the result in PackedArray to save memory usage):
In[]:=
max=FunctionCompile[Function[Typed[arg,TypeSpecifier["PackedArray"]["MachineInteger",1]], FoldList[Max,#]&[arg]]];
In[]:=
maxdata=max[acc];
Make a ListLinePlot for a million steps:
In[]:=
ListLinePlot[Take[maxdata,10^6]]
Out[]=
For 10 million steps (sampled 10^5 points plot):
In[]:=
ListLinePlot[Transpose[{Range[1,10^7,100],maxdata[[1;;10^7;;100]]}]]
Out[]=
For 100 million steps:
In[]:=
ListLinePlot[Transpose[{Range[1,10^8,1000],maxdata[[1;;10^8;;1000]]}]]
Out[]=
For a billion steps:
In[]:=
ListLinePlot[Transpose[{Range[1,10^9,1000],maxdata[[1;;10^9;;1000]]}]]
Out[]=
Zero Crossings
Zero Crossings
Plotting the zero crossings, note that the plots from 1M to 1000M all look the same—this is because after 200,000, there are no more 0 positions.
Make a ListLinePlot for a million steps:
ListLinePlot[Flatten[Position[Take[acc,10^6],0]]]
Out[]=
For 10 million steps:
ListLinePlot[Flatten[Position[Take[acc,10^7],0]]]
Out[]=
For 100 million steps:
ListLinePlot[Flatten[Position[Take[acc,10^8],0]]]
Out[]=
For a billion steps:
ListLinePlot[Flatten[Position[acc,0]]]
Out[]=
In[]:=
Position[Take[acc,10^6],0]===Position[Take[acc,10^7],0]
Out[]=
True
Cite this as: Xiangdong Wen, "Analysis of Black and White Cells in the Center Column of Rule 30" from the Notebook Archive (2019), https://notebookarchive.org/2019-09-dtysya8
Download
