Repetition Periods for Elementary Cellular Automata

A collection of rules and their repetition periods as a function of size

A plot of these repetition periods as originally provided on page 260 of A New Kind of Science (Wolfram, 2002) and a visualization was provided on page 259

(2 columns, 5 rows)

Examples

Basic Examples

Retrieve the ResourceObject:

In[1]:=
ResourceObject["Repetition Periods for Elementary Cellular Automata"]
Out[1]=

View the data:

In[2]:=
ResourceData["Repetition Periods for Elementary Cellular Automata"]
Out[2]=

Visualization

Find the systems provided:

In[3]:=
Normal@ResourceData[
   "Repetition Periods for Elementary Cellular Automata"][[All, 
  "Rule"]]
Out[3]=

Find the systems sizes for rule 90 with repetition period between 5 and 50:

In[4]:=
Select[
 Select[Normal@
    ResourceData[
     "Repetition Periods for Elementary Cellular Automata"], #Rule == 
     90 &][[1, "RepetitionPeriods"]],
 Between@{5, 50}
 ]
Out[4]=

Plot these:

In[5]:=
Module[{rule = 90, repetitionPeriods},
 repetitionPeriods = 
  Select[Normal@
     ResourceData[
      "Repetition Periods for Elementary Cellular Automata"], #Rule ==
       rule &][[1, "RepetitionPeriods"]];
 Table[
  ArrayPlot@
   CellularAutomaton[rule,
    ReplacePart[
     ConstantArray[0, n],
     Ceiling@(n/2) -> 1
     ],
    100
    ],
  {n,
   Keys@
     Reverse@Sort@
       Select[repetitionPeriods, Between@{5, 50}] // Take[#, UpTo[5]] &
   }
  ]
 ]
Out[5]=

Highlight the repeating blocks:

In[6]:=
Module[{rule = 90, repetitionPeriods, repBlock,
  firstRep, evolution},
 repetitionPeriods = 
  Select[Normal@
     ResourceData[
      "Repetition Periods for Elementary Cellular Automata"], #Rule ==
       rule &][[1, "RepetitionPeriods"]];
 Table[
  evolution =
   CellularAutomaton[rule,
    ReplacePart[
     ConstantArray[0, n],
     Ceiling@(n/2) -> 1
     ],
    100
    ];
  firstRep =
   FirstCase[Range[100],
    _?(
      # <= (100 - repetitionPeriods[n]) &&
        evolution[[#]] ==
         evolution[[repetitionPeriods[n] + #]] &)
    ];
  ArrayPlot[
   ReplacePart[evolution,
    firstRep |
      _?(# >= firstRep &&
          
          Mod[# - firstRep + 1, repetitionPeriods[n]] == 0 &) ->
     Table[2, n]
    ],
   ColorRules -> {
     1 -> GrayLevel[0.1],
     2 -> Hue[.6, 1, 1]
     }
   ],
  {n,
   Keys@
     Reverse@Sort@
       Select[repetitionPeriods, Between@{5, 50}] // 
    Take[#, UpTo@5] &
   }
  ]
 ]
Out[6]=

Wolfram Research, "Repetition Periods for Elementary Cellular Automata" from the Wolfram Data Repository. (2017) https://doi.org/10.24097/wolfram.75508.data

License Information

CC BY-SA 4.0

Source Metadata

Data Downloads