Function Repository Resource:

AutomatonParticleDetect

Search through one-dimensional cellular automata for periodic structures

Contributed by: Bradley Klee

ResourceFunction["AutomatonParticleDetect"][rule,seed,pad,time]

tests for periodic structure after time steps of the iterator CellularAutomaton[rule] acting initially on a seed surrounded by pad values, and returns a descriptive association in case of a true positive.

Details

The algorithm assumes rule to be 1D.

Both seed and pad must be lists with valid values (in the domain of rule).

Where possible, the pad should be chosen to generate a static or periodic background, upon which seed can be observed to grow.

The search algorithm has a conservative search criterion requiring three complete periods for particle (one dimensional glider) identificiation.

A useful heuristic when searching for a particle of period T₀ is to set time=3T₀+10, but search success also depends on seed.

ResourceFunction["AutomatonParticleDetect"] takes the following options:

"Canonicalize"

True

determines whether or not to post process output data

Method

"Structured"

specify how canonicalization handles throughput data

Either Method "Structured" or "Simple" passes to a hidden call of the resource function SubmatrixReplace, which is used when trimming raw particle data.

Examples

Basic Examples (6)

Test seed {1,0,0,0,1} against the dominant periodic background of Rule 110:

In[1]:=

ResourceFunction["AutomatonParticleDetect"][110, {1, 0, 0, 0, 1},
{0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1},
60, Method -> "Structured"]

Out[1]=

Depict the particle as it moves through about four periods:

In[2]:=

With[{positive =
ResourceFunction["AutomatonParticleDetect"][110, {1, 0, 0, 0, 1},
{0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1},
60, Method -> "Structured"]},
Labeled[ArrayPlot[
CellularAutomaton[#["Rule"],
Function[{seed, pad, len}, Flatten[
{Table[pad, {Ceiling[len/Length[pad]/2]}], seed,
Table[pad, {Ceiling[len/Length[pad]/2]}]}]
][#["Data"][[1]], #["Background"][[1]], 60], 60],
ColorRules -> {0 -> LightOrange, 1 -> Brown},
Frame -> None , PixelConstrained -> 4],
Row[{"dt: ", #["Period"], " dx: ", #["Shift"]}]
] &@positive]

Out[2]=

Detect particles in elementary Cellular Automaton Rule 110 by noting when "Result" equals True:

In[3]:=

ResourceFunction["AutomatonParticleDetect"][110, IntegerDigits[#, 2],
{0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1},
60, Method -> "Structured"]["Result"] & /@ Range[5]

Out[3]=

Make a data table for the first positive of Rule 110:

In[4]:=

$Grid[Transpose[{Text /@ Keys[#], Values[#] /. List[mat__List] :> MatrixForm[List[mat]] } &@ResourceFunction["AutomatonParticleDetect"][110, IntegerDigits[3, 2], {0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1}, 60, Method -> "Structured"]], Spacings -> {2, 2}, FrameStyle -> LightGray, Frame -> All]$

Out[4]=

Map over a small search space for unique particles and check their velocity statistic:

In[5]:=

$With[{positives = Union[Select[ ResourceFunction["AutomatonParticleDetect"][110, IntegerDigits[#, 2], {0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1}, 50, Method -> "Structured"] & /@ Range[2^5], #["Result"] &]]}, #["Velocity"] & /@ positives]$

Out[5]=

Change the time parameter to run search longer and possibly find more positive results:

In[6]:=

$With[{positives = Union[Select[ ResourceFunction["AutomatonParticleDetect"][110, IntegerDigits[#, 2], {0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 0, 0, 0, 1}, 60, Method -> "Structured"] & /@ Range[2^5], #["Result"] &]]}, #["Velocity"] & /@ positives]$

Out[6]=

Options (2)

For the purpose of algorithm timing analysis, it is possible to pass Method "Simple":

In[7]:=

$AbsoluteTiming[With[{positives = Union[Select[ ResourceFunction["AutomatonParticleDetect"][{20, {2, 1}, 2}, IntegerDigits[#, 2], {0, 0, 0}, 150, Method -> "Simple" ] & /@ Range[2^10], #["Result"] &]]}, #["Velocity"] & /@ positives]]$

Out[7]=

However, Method "Simple" is expected to be slow relative to the default "Structured":

In[8]:=

$AbsoluteTiming[With[{positives = Union[Select[ ResourceFunction["AutomatonParticleDetect"][{20, {2, 1}, 2}, IntegerDigits[#, 2], {0, 0, 0}, 150, Method -> "Structured" ] & /@ Range[2^10], #["Result"] &]]}, #["Velocity"] & /@ positives]]$

Out[8]=

Neat Examples (2)

Search for, find and depict numerous different particles in one short-time call:

In[9]:=

$ShallowSearchResults[code_] := With[{positives = SortBy[Union[Select[ ResourceFunction["AutomatonParticleDetect"][code, IntegerDigits[#, 3], {0}, 60, Method -> "Structured"] & /@ Range[1, 3^5], #["Result"] &]], #["Velocity"] &]}, Labeled[ArrayPlot[ CellularAutomaton[#["Rule"], Function[{seed, pad, len}, Flatten[ {Table[pad, {Ceiling[(len + 3)/Length[pad]/2]}], seed, Table[pad, {Ceiling[(len + 3)/Length[pad]/2]}]}] ][#["Data"][[1]], #["Background"], 3 Max[#["Period"], 10]], 3 Max[#["Period"], 10] - 1], ColorRules -> {0 -> LightBrown, 1 -> LightGreen, 2 -> Brown}, Frame -> None , PixelConstrained -> 4], Row[{"dt: ", #["Period"], " dx: ", #["Shift"]}] ] & /@ positives]$