The Right Side of Rule 30

October 28, 2005
Midwest NKS Conference
Bloomington, Indiana

Eric Rowland
Rutgers University
erowland@math.rutgers.edu

Several functions used in this presentation are part of the following package, which can be downloaded from
http://math.rutgers.edu/~erowland/programs.html.

<< BijectiveRules`

Introduction

Let I be the infinite row consisting of a single black cell among a background of white cells.  By "rule 30*" we will mean "rule 30 begun from the initial condition I".
We are all familiar with the periodicity of the left diagonals of rule 30*.

ArrayPlot[CellularAutomaton[30, {{1}, 0}, 100]];

It turns out that there is some structure on the right side as well.

ArrayPlot[
        CellularAutomaton[30, {{1}, 0}, 
          600, {All, {-100, 600}}]];

The situation is simpler conceptually and notationally if we consider the "left-shifted" version of rule 30:

ArrayPlot[
        CellularAutomaton[{30, 2, {{0}, {1}, {2}}}, {{1}, 0}, 
          50]];

What is length (Subscript[ι, I])(t) of the rightmost sequence of black cells on row t?

Length /@ Last /@ Split /@ 
          CellularAutomaton[{30, 2, {{0}, {1}, {2}}}, {{1}, 0}, 
            100]

Table[IntegerExponent[n, 2], {n, 16}]

New numbers a(n) appear at positions (2^n):

Length /@ Last /@ Split /@ CellularAutomaton[{30, 
                2, {{0}, {1}, {2}}}, {{1}, 0}, 
              (2^12) - 1, {All, {-40, 
                  0}}][[(2^Range)[0, 12]]]

Here is the sequence {a(n)} up to row (2^40) (over one trillion).  This computation took about four months.
(The next term will be finished on January 19, 2006.  See http://math.rutgers.edu/~erowland/math/myst41.)

What about other initial conditions?

Length /@ Last /@ Split /@ 
          CellularAutomaton[{30, 2, {{0}, {1}, {2}}}, {{1, 1}, 0}, 
            20]

Length /@ Last /@ Split /@ 
          CellularAutomaton[{30, 2, {{0}, {1}, {2}}}, {{1, 0, 1}, 0}, 
            20]

...

This initial condition is the second row of rule 30*:

Length /@ Last /@ Split /@ 
          CellularAutomaton[{30, 2, {{0}, {1}, {2}}}, {{1, 1, 1}, 0}, 
            20]

This looks promising at first...

Length /@ Last /@ Split /@ 
          CellularAutomaton[{30, 2, {{0}, {1}, {2}}}, {{1, 0, 0, 1}, 0}, 
            20]

...but in fact it's periodic.  (The function Period comes from another of my packages.)

Period[
      Length /@ Last /@ Split /@ 
            CellularAutomaton[{30, 2, {{0}, {1}, {2}}}, {{1, 0, 0, 1}, 0}, 
              100]]

Conjecture.  The only finite initial conditions that give rise to nonperiodic sequences are those appearing in rule 30*.
I have verified this for all rows whose finite part is at most 24 cells.
(We will prove that {a(n)} is in fact nonperiodic.)

The conjecture is not true for a more general case:  We can construct, from right to left, a nonfinite row R with the property that (Subscript[ι, R])(t) = 
        a(IntegerExponent[3  t + 1, 2]).

Table[IntegerExponent[3 t + 1, 2], {t, -10, 10}]

For comparison:

Table[IntegerExponent[t, 2], {t, -10, 10}]

ArrayPlot[
        Reverse /@ 
          ToArray[Evolve[{86, 2, 
                2}, {{0, {0, 1, 0, 0, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 1, 0, 
                    1, 1, 1, 0, 1, 1, 0, 1, 0, 1, 0, 0, 1, 1, 0, 1, 0, 0, 0, 
                    1, 1, 1}}}, {-20, 20}]]];

Reversibility

When is rule 30 reversible?  That is, when can we find a predecessor to a given row (and is this predecessor unique)?

<< NKSExplorer`
NKSDisplay[24.1, {30}, Heading -> False];

Fact.  Rule 30 is left bijective.  (In A New Kind of Science, this concept goes by the name "one-sided additivity".)
Consequence.  If one cell in a predecessor is determined, then all cells to the left of that cell are determined.

Definition.  A row is called leftful if there is a cell to the right of which all cells are white.
That is, all the information is on the left.

Therefore, a leftful row with a leftful predecessor has a unique infinite leftful history.

For rule 30*, this history begins like this:

ArrayPlot[
        Reverse /@ 
          ToArray[Evolve[{86, 2, 
                2}, {{0, Prepend[Table[0, {100}], 1]}}, {-100, 
                100}]]];

Lemma.  If columns m + 2 and m + 1 have period lengths (Subscript[p, m + 2]) and (Subscript[p, m + 1]) respectively, then column m has period length dividing 2  LCM[(Subscript[p, m + 1]), (Subscript[p, m + 2])].

Definition.  Let f be the left-shifted rule 30, and let R be a leftful row.  We say that a sequence {(Subscript[R, n])} of rows converges to R as n -> ∞ (and write (Subscript[R, n]) -> R) if for every -m there exists N such that for every n ≥ N, (Subscript[R, n]) agrees with R to the right of position -m.

Theorem.  Let R be a leftful row with a leftful predecessor.  Then (f^((2^n))) R -> R as n -> ∞.
(A general theorem of this form holds for every left bijective, k-color cellular automaton rule.)

Proof.  Let column -1 be the first nonwhite column in the evaluation of f from R.  Column -1 is solid black, so it has period length 1.  Column 0, the column to the right of column -1, is solid white, so it also has period length 1.  By the lemma, column -m - 1 (m ≥ 0) has period length dividing (2^m).  Therefore, (f^((2^m))) R agrees with R to the right of position -m - 2.  Letting m -> ∞ gives (f^((2^m))) R -> R.

Corollary.  The row (f^(-1)) I is black to the left of position 0 and white elsewhere.  Thus (Subscript[ι, I])(-1) = ∞, so the theorem gives (Subscript[ι, I])(
            (2^n) - 1) -> (Subscript[ι, I])(-1) = ∞ as n -> ∞.

This shows that {a(n)} is nonperiodic; indeed, it is unbounded.
In particular, the cell at position -n - 1 on row (2^n) - 1 of rule 30* is black!
Can this be considered a computational reduction?  maybe a trivial one.

Other left bijective rules

There are sixteen left bijective elementary rules:

LeftBijectiveRules[2, 2]

AutomatonGraphic[number_, colors_, range_, initialcondition_, 
        size_ : 3] := 
      Module[{dim, 
          state = CellularAutomaton[{number, colors, 
                List /@ (Range[range] - 1)}, initialcondition, 
              24, {All, All}]}, dim = Reverse[Dimensions[state]]; 
        Graphics[Raster[Reverse[1 - (state/(colors - 1))]], 
          AspectRatio -> Automatic, 
          PlotRange -> {{0, 
                dim[[1]]}, {0, 
                dim[[2]]}}, 
          ImageSize -> size dim + 1, 
          PlotLabel -> number]]

Show[
        GraphicsArray[
          Map[AutomatonGraphic[#1, 2, 3, {{1}, 0}] &, 
            Partition[LeftBijectiveRules[2, 2], 4], {2}]]];

How many black cells are at the right side of row t in rule 45*?

Length /@ Last /@ Split /@ 
          CellularAutomaton[{45, 2, {{0}, {1}, {2}}}, {{1}, 0}, 
            100]

This is periodic.
To get analogies of the sequence 1, 3, 4, 6, 7, 9, ..., it turns out that we shouldn't just consider the lengths of the rightmost sequence of black cells, but the rightmost sequence of cells that agree with the predecessor of our initial condition.

For example, the leftful predecessor of I under rule 45 is the following row.

LeftfulPredecessor[{45, 2, 2}, {Append[Table[0, {10}], 1], 
        0}]

Here's the beginning of the history.

ArrayPlot[
        Reverse /@ 
          ToArray[Evolve[{101, 2, 
                2}, {{0, Prepend[Table[0, {100}], 1]}}, {-100, 
                100}]]];

The λ sequence given begins

(Lambda[
            Prepend[Table[0, {100}], 
              1], #1[[2]]] &) /@ 
      Evolve[{101, 2, 2}, {{0, Prepend[Table[0, {100}], 1]}}, 100]

Union[Rest[%]]

Rule 45 has an alternating background.  If instead we start with a single white cell with a black background, we get a different sequence.

(Lambda[
            Prepend[Table[1, {100}], 
              0], #1[[2]]] &) /@ 
      Evolve[{101, 2, 2}, {{0, Prepend[Table[1, {100}], 0]}}, 100]

Union[Rest[%]]

For rule 75, the sequence begins

(Lambda[
            Prepend[Table[1, {100}], 
              0], #1[[2]]] &) /@ 
      Evolve[{89, 2, 2}, {{0, Prepend[Table[1, {100}], 0]}}, 100]

Union[Rest[%]]

LeftfulPredecessor[{75, 2, 2}, {Append[Table[0, {10}], 1], 
        0}]

ArrayPlot[
        Reverse /@ 
          ToArray[Evolve[{89, 2, 
                2}, {{0, Prepend[Table[0, {100}], 1]}}, {-30, 
                30}]]];

For rule 135, the sequence begins

(Lambda[
            Prepend[Table[1, {100}], 
              0], #1[[2]]] &) /@ 
      Evolve[{149, 2, 2}, {{0, Prepend[Table[1, {100}], 0]}}, 100]

Why is this periodic?  It's because I has no leftful predecessor under rule 135.  So really we should be looking at rows with black backgrounds.  Then we get a nice nonperiodic sequence:

(Lambda[
            Prepend[Table[0, {100}], 
              1], #1[[2]]] &) /@ 
      Evolve[{149, 2, 2}, {{1, Prepend[Table[0, {100}], 1]}}, 100]

Union[Rest[%]]

LeftfulPredecessor[{135, 2, 2}, {Append[Table[0, {10}], 1], 
        1}]

In fact, rule 135 is just the "inverted" rule 30.

ArrayPlot[
        Reverse /@ 
          ToArray[Evolve[{149, 2, 
                2}, {{1, Prepend[Table[0, {100}], 1]}}, {-30, 
                30}]]];

Show[
        GraphicsArray[
          Map[AutomatonGraphic[#1, 2, 3, {{1}, 0}] &, 
            Partition[{15, 30, 45, 60, 75, 90, 105, 120, 150, 180, 210, 240}, 
              4], {2}]]];

Show[
        GraphicsArray[
          Map[AutomatonGraphic[#1, 2, 3, {{0}, 1}] &, 
            Partition[{15, 45, 75, 105, 135, 150, 165, 180, 195, 210, 225, 
                240}, 4], {2}]]];

What about non-elementary rules?

Some (interesting) 2-color right bijective rules that depend on four cells:

ArrayPlot[
        CellularAutomaton[{42586, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{42665, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{43369, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{39270, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{43621, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{25945, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{39526, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{39590, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{39593, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{42646, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{42650, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{43670, 
            2, {{-3}, {-2}, {-1}, {0}}}, {{1}, 0}, 
          256]];

Here are them all, begun from I (that is, without regard for infinite histories).
One curious observation is that there is a complete lack of class four behavior.

AutomatonGraphic[number_, colors_, range_, initialcondition_, 
        size_ : 3] := 
      Module[{dim, 
          state = CellularAutomaton[{number, colors, 
                List /@ Reverse[1 - Range[range]]}, initialcondition, 
              100, {All, All}]}, dim = Reverse[Dimensions[state]]; 
        Graphics[Raster[Reverse[1 - (state/(colors - 1))]], 
          AspectRatio -> Automatic, 
          PlotRange -> {{0, 
                dim[[1]]}, {0, 
                dim[[2]]}}, 
          ImageSize -> size dim + 1, 
          PlotLabel -> number]]

With[{k = 2, r = 3}, 
        Show[GraphicsArray[
            Map[AutomatonGraphic[#1, k, r + 1, {{1}, 0}] &, 
              Partition[RightBijectiveRules[k, r], 2], {2}]]]];

Here are some nested 3-color right bijective rules depending on two cells.

ArrayPlot[
        CellularAutomaton[{5623, 3, {{-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{5675, 3, {{-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{8169, 3, {{-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{8435, 3, {{-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{11513, 3, {{-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{15503, 3, {{-1}, {0}}}, {{1}, 0}, 
          256]];

ArrayPlot[
        CellularAutomaton[{15519, 3, {{-1}, {0}}}, {{1}, 0}, 
          256]];

AutomatonGraphic[number_, colors_, range_, initialcondition_, 
        size_ : 3] := 
      Module[{dim, 
          state = CellularAutomaton[{number, colors, 
                List /@ Reverse[1 - Range[range]]}, initialcondition, 
              50, {All, All}]}, dim = Reverse[Dimensions[state]]; 
        Graphics[Raster[Reverse[1 - (state/(colors - 1))]], 
          AspectRatio -> Automatic, 
          PlotRange -> {{0, 
                dim[[1]]}, {0, 
                dim[[2]]}}, 
          ImageSize -> size dim + 1, 
          PlotLabel -> number]]

All 3-color right bijective rules depending on two cells (begun from I):

With[{k = 3, r = 1}, 
        Show[GraphicsArray[
            Map[AutomatonGraphic[#1, k, r + 1, {{1}, 0}] &, 
              Partition[RightBijectiveRules[k, r], 4], {2}]]]];