Implementation [of cellular automaton state networks]

One can represent a network by a list such as {{1 2}, {0 3, 1 2}, {0 3, 1 1}} where each element represents a node whose number corresponds to the position of the element, and for each node there are rules that specify to which nodes arcs with different values lead. Starting with a list of nodes, the nodes reached by following arcs with value a for one step are given by

NetStep[net_, i_, a_] := Union[ReplaceList[a, Flatten[net〚i〛]]]

A list of values then corresponds to a path in the network starting from any node if

Fold[NetStep[net, #1, #2]&, Range[Length[net]], list] =!= {}

Given a set of sequences of values represented by a particular network, the set obtained after one step of cellular automaton evolution is given by

NetCAStep[{k_, r_, rtab_}, net_] := Flatten[Map[Table[# /. (a_s_) (rtab〚i k + a + 1〛 k^{2r} (s - 1) + 1 + Mod[i k + a, k^{2r}]), {i, 0, k^{2r} - 1}]&, net], 1]

where here elementary rule 126 is specified for example by {2, 1, Reverse[IntegerDigits[126, 2, 8]]}. Starting from the set of all possible sequences, as given by

AllNet[k_:2] := {Thread[(Range[k] - 1) 1]}

this then yields for rule 126 the network

{{0 1, 1 2}, {1 3, 1 4}, {1 1, 1 2}, {1 3, 0 4}}

It is always possible to find a minimal network that represents a set of sequences. This can be done by first creating a "deterministic" network in which at most one arc of each value comes out of each node, then combining equivalent nodes. The whole procedure can be performed using

MinNet[net_, k_:2] := Module[{d = DSets[net, k], q, b}, If[First[d] =!= {}, AllNet[k], q = ISets[b = Map[Table[Position[d, NetStep[net, #, a]]〚1, 1〛, {a, 0, k - 1}]&, d]]; DeleteCases[MapIndexed[#2〚2〛 - 1 #1 &, Rest[Map[Position[q, #]〚1, 1〛&, Transpose[Map[Part[#, Map[First, q]]&, Transpose[b]]], {2}]] - 1, {2}], _ 0, {2}]]]

DSets[net_, k_:2] := FixedPoint[Union[Flatten[Map[Table[NetStep[net, #, a], {a, 0, k - 1}]&, #], 1]]&, {Range[Length[net]]}]

ISets[list_] := FixedPoint[Function[g, Flatten[Map[Map[Last, Split[Sort[Part[Transpose[{Map[Position[g, #]〚1, 1〛&, list, {2}], Range[Length[list]]}], #]], First[#1] First[#2]&], {2}]&, g], 1]], {{1}, Range[2, Length[list]]}]

If net has q nodes, then in general MinNet[net] can have as many as 2^{q}-1 nodes. The form of MinNet given here can take up to about n^{2} steps to generate a result with n nodes; an n Log[n] procedure is known. The result from MinNet for rule 126 is {{1 3}, {0 2, 1 1}, {0 2,1 3}}.

In general MinNet will yield a network with the property that any allowed sequence of values corresponds to a path which starts from node 1. In the main text, however, the networks allow paths that start at any node. To obtain such trimmed networks one can apply the function

TrimNet[net_] := With[{m = Apply[Intersection, Map[FixedPoint[Union[#, Flatten[Map[Last, net〚#〛, {2}]]]&, #]&, Map[List, Range[Length[net]]]]]}, net〚m〛 /. Table[(a_ m〚i〛) (a i), {i, Length[m]}]]