The genetics of cellular automata

Rodrigo A. Obando, Columbus State University

(RowDefault[, (Spacer1), , (Spacer1), ])  #WolframTechConf

ABSTRACT

When John Von Neumann proposed cellular automata to investigate artificial life, he modeled the part that defines their behavior as a subsystem. This subsystem is embodied in the cellular automata rules. Researchers have investigated these rules throughout the decades to model not only artificial life but many other physical and natural systems. Each cellular automata rule has been represented by a single function with its neighboring cells as inputs. These functions are in turn represented by integers that encode the outputs for a given set of inputs. We present a model where we split the individual rules into k number of functions where k is the number of possible values of the cell. These functions are named genes. Using this model, we can partition the rule space using these genes and investigate how each gene affects the rules they build. It happens that for a given rule space defined by k and r each of its rules is defined by genes which are in turn rules of the rule space defined by k and r - ½. This allows us to explore the genetics of a rule by creating a genealogy tree that traces all genes that create the rule from the most primitive rules in the rule space defined by k and r = 0 and all the levels in between.

Introduction

We have used Cellular Automata to explore many areas in Science. This simple model serves as a good starting point to investigate many a process or system. Many researchers discover Cellular Automata rules that simulate or model particular behaviors and they have proven to be useful. We hear about particularly interesting rules such as 110 and 30 in the Elementary Cellular Automata rule space (ECA.) The first one is classified as Class 4 or Complex and the second as Class 3 or Random. There are many others that may no be as interesting but nonetheless they do exist in the same space.

In one-dimensional cellular automata, the size of the space depends on the number k of possible values for a cell and the r number of neighboring cells considered to influence the value of the cell on the next evolution step.

Rule Space Layout

The ECA is the space defined when r = 1. There are just 256 rules and these have been explored and studied throughout the years. If we make r = 3/2, the size of the space is 65536 and this space may not have been explored and studied as much as the ECA due to its size. A value of r = 2 makes the rule space size about 4 billion rules and this space has not been explored either. How do we explore such big spaces? The general view on these spaces is that they do not have a particular structure, that they are a ‘blob.’ Many have defined some schemes but in general they do not provide a suitable way to navigate such spaces in a way that can be applied to all the spaces for different values of r. In fact, the way we normally list the rules in the ECA or any other space is by simply numbering them from 0 to the maximum number minus one. This particular ordering of the rules provides no hint on how the rules relate to each other one way or another. We find that the behavior and the rule numbers have no way of relating similar rules. We can see such listing of the ECA in a New Kind of Science by Wolfram [A] pages 55 and 56. The following figures show the spaces for r = 0, r=1/2 and r = 1.

Manipulate[GraphicsGrid[Outer[Tooltip[ArrayPlot[CellularAutomaton[{#2+#1 2^2^(2r),2,r},If[#2≥#1,init,1-init],{50,{-50,50}}],ColorRules-> {0->White,1->colors[[ComputeWolframClass[#2+#1 2^2^(2r),2,r,random]]],_->Black}],#2+#1 2^2^(2r)]&,Range[0,2^2^(2r)-1],Range[0,2^2^(2r)-1]],Frame->True,Dividers->All],{{r,0},{0,1/2,1}},{init,{{{1},0}->"Simple",random->"Random"}},SaveDefinitions->True]

Gene functions

We use the concept of rule gene, first introduced in [B] but under the name of rule primitive, and we split each rule into genes or a gene vector. Each gene does not evolve as a rule but it defines the rule’s behavior given the value of the cell. For k = 2, each rule is split into 2 genes or a 2-dimensional gene vector ({g0, g1}.)  The gene in position 0 defines how the cell evolves given that the value of the cell is 0 and the gene in position 1 defines how the cell evolves given that the value of the cell is 1. We may say that each gene gets activated by the value of the cell. A value of 0 activates the gene in position 0 (g0) and a value of 1 activates the gene in position 1 (g1.) Just as the rule number represents an equation or function so do the genes. You may see details in [B].

Rules and their genes

Table 1. Examples of rules and their genes with k = 2 and r = 1.

Grid[{#,RuleGenes[#,2,1]}&/@{30,135,23,45,60,90,110,137},Frame->All]

Table 2. Examples of rules and their genes with k = 3 and r = 1.

Grid[{#,RuleGenes[#,3,1]}&/@{922461,1859893720908,1974568397415,2523185237382,1556002847247,1450408494138,825467022366,626413316244,776233778217,1027824872631,1565177072649,434501270529,1220959765302,317418638253,1256286383349,1806467601669},Frame->All]

Rule layout using genes

Manipulate[GraphicsGrid[Outer[Tooltip[ArrayPlot[CellularAutomaton[{FromGenes[{GeneSet[2,r][[#2+1]],OffsetGeneSet[2,r][[#1+1]]},2,r],2,r},If[#2≥#1,init,1-init],{50,{-50,50}}],ColorRules-> {0->White,1->colors[[ComputeWolframClass[FromGenes[{GeneSet[2,r][[#2+1]],OffsetGeneSet[2,r][[#1+1]]},2,r],2,r,random]]],_->Black}],FromGenes[{GeneSet[2,r][[#2+1]],OffsetGeneSet[2,r][[#1+1]]},2,r]]&,Range[0,2^2^(2r)-1],Range[0,2^2^(2r)-1]],Frame->True,Dividers->All],{{r,0},{0,1/2,1}},{init,{{{1},0}->"Simple",random->"Random"}},SaveDefinitions->True]

Genealogy trees

We may use the layout of the rule spaces to have a glimpse on how the rules and their behavior are distributed in the space. We may observe that a particular row or column has a gene in common and it defines part of the overall behavior of the rule.
There exist a relationship between the rule spaces with different values of r. For instance, the ECA (k=2, r=1) rules have the genes defined by the same functions of the rules for the smaller rule space (k=2, r=1/2) and this fact allows us to display some kind of ‘ancestry’ for a given rule.
We define a genealogy tree as a graph where a rule is related to its genes, and each gene, which is a rule function in the smaller space, is also related its own genes. We may create this graph that provides insight on how the rules are formed based on its ‘ancestry.’

Manipulate with genealogy trees

Manipulate[LayeredGraphPlot[AncestorGraphEvolution[rule,2,1],VertexLabels->Automatic],{rule,0,255,1}]

Comparing rules

GraphicsGrid[{{LayeredGraphPlot[AncestorGraphEvolution[30,2,1,RSeed[2]],VertexLabels->Automatic],
LayeredGraphPlot[AncestorGraphEvolution[135,2,1,1-RSeed[2]],VertexLabels->Automatic]}}]

Rule splicing

The idea of having ‘genes’ in the formation of rules yields the possibility of splicing genes from one rule space into another for a different value of k. For instance, we can take a rule in k=2, r=1 and splice it and make a rule in k=3, r=1 that has the same behavior.

GraphicsGrid[{{ArrayPlot[CellularAutomaton[{110, 2, 1}, {{1},0}, {50, {-50, 50}}], PlotLabel -> ToString[{110, 2,1}]],ArrayPlot[CellularAutomaton[{RuleSplice[110,2,1,IdentityRule[3,1],3,1], 3, 1}, {{1},0}, {50, {-50, 50}}], PlotLabel -> ToString[{RuleSplice[110,2,1,IdentityRule[3,1],3,1], 3,1}]]},{ArrayPlot[CellularAutomaton[{30, 2, 1}, {{1},0}, {50, {-50, 50}}], PlotLabel -> ToString[{30, 2,1}]],ArrayPlot[CellularAutomaton[{RuleSplice[30,2,1,IdentityRule[3,1],3,1], 3, 1}, {{1},0}, {50, {-50, 50}}], PlotLabel -> ToString[{RuleSplice[30,2,1,IdentityRule[3,1],3,1], 3,1}]]}}]

Genealogy trees of spliced rules

GraphicsGrid[{{LayeredGraphPlot[AncestorGraphEvolution[110,2,1,{{1},0}],VertexLabels->Automatic]},{
LayeredGraphPlot[AncestorGraphEvolution[RuleSplice[110,2,1,IdentityRule[3,1],3,1],3,1,{{1},0}],VertexLabels->Automatic]}}]

Conclusion

The approach presented here is useful in providing insight into the make up of the cellular automata rules and how they related to their components (genes.) It partitions the rule spaces in such a way that gives direction on how to not only search for rules but also ‘genetically’ engineer rules by selecting appropriate genes for their creation. This framework provides the idea of genealogy trees to study what parts of the rules may be responsible for certain kind of behavior. We may isolate particular genes that may be of interest and even ‘splicing’ them into other rule spaces with a larger number of values (k.)

References

[A] Wolfram, Stephen, A New Kind of Science,  Champaign, IL: Wolfram Media, 2002.

[B] Obando, Rodrigo, “Partitioning of Cellular Automata Rule Spaces,” Complex Systems, 24, 2015 pp. 27–48.

Miscellaneous

colors = {RGBColor[0, 0, 1], RGBColor[1, 0.5, 0], RGBColor[1, 0, 0], RGBColor[0.5, 0, 0.5]};
random = RandomInteger[{0, 1}, 100];
RSeed[k_] := RSeed[k] =
    Table[RandomInteger[k - 1], {n, 1, 100}];
GetCycles[hist_, numberToDrop_] :=
    Length[Union[Drop[hist, numberToDrop]]];
Classifier[hist_] :=
    Module[{shifts = Table[RotateRight[hist[[-3]], n], {n, -5, 5}], compare, theClass},
        compare = Flatten[Position[Table[shifts[[n]] == hist[[-1]], {n, 1, Length[shifts]}], True]];
        If[Length[compare] == 0,
            theClass = 3
            ,
            If[MemberQ[compare, 6],
                theClass = 1
                ,
                theClass = 2
            ]
        ];
        theClass
    ];
Detangler[class_, cycles_] :=
    If[cycles == 1,
        1
        ,
        If[cycles <= 512,
            2
            ,
            If[class == 2,
                class
                ,
                If[class == 3 && cycles > 512,
                    class
                    ,
                    2
                ]
            ]
        ]
    ];
ComputeWolframClass[rule_, k_,r_, init_] :=
    Module[{longHistory = CellularAutomaton[{rule, k, r}, init, {1000, All}]},
        Detangler[Classifier[longHistory], GetCycles[longHistory, 50]]
    ];
GetWolframClass[rule_]:=Module[{classes={{0,4,8,12,13,32,36,40,44,64,68,69,72,76,77,78,79,92,93,96,100,104,128,132,136,140,141,160,164,168,172,192,196,197,200,202,203,204,205,206,207,216,217,218,219,220,221,222,223,224,228,232,233,234,235,236,237,238,239,248,249,250,251,252,253,254,255},{1,2,3,5,6,7,9,10,11,14,15,16,17,19,20,21,23,24,25,26,27,28,29,31,33,34,35,37,38,39,41,42,43,46,47,48,49,50,51,52,53,55,56,57,58,59,61,62,63,65,66,67,70,71,73,74,80,81,82,83,84,85,87,88,91,94,95,97,98,99,103,107,108,109,111,112,113,114,115,116,117,118,119,121,123,125,127,130,131,133,134,138,139,142,143,144,145,148,152,154,155,156,157,158,159,162,163,166,167,170,171,173,174,175,176,177,178,179,180,181,184,185,186,187,188,189,190,191,194,198,199,201,208,209,210,211,212,213,214,215,226,227,229,230,231,240,241,242,243,244,245,246,247},{18,22,30,45,60,75,86,89,90,101,102,105,106,120,122,126,129,135,146,149,150,151,153,161,165,169,182,183,195,225},{54,110,124,137,147,193}}},
Do[If[MemberQ[classes[[n]],rule],Return[n]],{n,1,Length[classes]}]];
MyEntropy[p_List] :=
    -p . Log[2, p];
ColorRate[ca_List] :=
    N[{Count[Flatten[#[[1]]], 0] / #[[2]], Count[Flatten[#[[1]]], 1] / #[[2]]}]&[{ca, Length[Flatten[ca]]}];
ReplaceRules[ca_List] :=
    {0 -> #[[1]], 1 -> #[[2]]}&[ColorRate[ca]];
ComputeEntropy[rule_, k_:2,r_:1,  init_:random] :=
    MyEntropy[ReplaceAll[Flatten[Union[#]], ReplaceRules[#]]]&[CellularAutomaton[{rule, k, r}, init, {50, All}]];

Gene Manipulation

FromGenes[genes_List, k_:2, r_:1] :=
    FromDigits[Flatten[Thread[Map[Partition[IntegerDigits[genes[[#]], k, k^(2 r)], k^Floor[r]]&, Reverse[Range[k]]]]], k];
RuleGenes[rule_, k_:2, r_:1] :=
    Module[{splitRule = Partition[IntegerDigits[rule, k, k^(2 r + 1)], k^Floor[r]]},
        Map[FromDigits[#, k]&, Map[Flatten[splitRule[[Table[n, {n, #, Length[splitRule], k}]]]]&, Reverse[Range[k]]]]
    ];
GenePrepend[digits_, k_] :=
    Module[{list1, list2},
        list1 = Table[digits, k];
        list2 = Reverse[Table[list1[[1, 1]] (n - 1), {n, k}]];
        Flatten[list1[[#]] + list2[[#]]& /@ Range[k]]
    ];
GeneThread[digits_, k_] :=
    Module[{list1, list2},
        list1 = Table[digits, k];
        list2 = Reverse[Table[list1[[1, 1]] (n - 1), {n, k}]];
        Flatten[Thread[list1[[#]] + list2[[#]]& /@ Range[k]]]
    ];
GeneSplice[geneFrom_, kFrom_:2, rFrom_:1, geneTo_, kTo_, rTo_] :=
    Module[{geneFromDigits = Reverse[IntegerDigits[geneFrom, kFrom, kFrom^(2 rFrom)]], geneToDigits = Reverse[IntegerDigits[geneTo, kTo, kTo^(2 rTo)]], subRules},
        subRules = FromDigits[IntegerDigits[#, kFrom], kTo] + 1 -> geneFromDigits[[# + 1]]& /@ Range[0, Length[geneFromDigits] - 1];
        geneToDigits = ReplacePart[geneToDigits, subRules];
        FromDigits[Reverse[geneToDigits], kTo]
    ];
RuleSplice[ruleFrom_, kFrom_:2, rFrom_:1, ruleTo_, kTo_, rTo_] :=
    Module[{genesFrom = RuleGenes[ruleFrom, kFrom, rFrom], genesTo = RuleGenes[ruleTo, kTo, rTo], subRules},
        subRules = # -> GeneSplice[genesFrom[[#]], kFrom, rFrom, genesTo[[#]], kTo, rTo]& /@ Range[kFrom];
        FromGenes[ReplacePart[genesTo, subRules], kTo, rTo]
    ];
IdentityRule[k_:2,r_:1]:=FromGenes[Map[FromDigits[Table[#,k^(2r)],k]&,Range[0,k-1]],k,r];

Gene Sets (Not yet suitable for k > 2)

ExtendGene[gene_, k_:2, r_:1] := Module[{extensions = Map[IntegerDigits[#, k, k^(2 r)]&, GeneSet[k, r]]},
    If[OddQ[2 r],
        Map[FromDigits[Flatten[Thread[{#, IntegerDigits[gene, k, k^(2 r)]}]], k]&, extensions]
        ,
        Map[FromDigits[Flatten[Prepend[IntegerDigits[gene, k, k^(2 r)], #]], k]&, extensions]
    ]
];
GeneSet[k_:2, 0] := Range[k] - 1;
GeneSet[k_:2, r_:1] := GeneSet[k, r] = Flatten[Map[ExtendGene[#, k, r - 1 / 2]&, GeneSet[k, r - 1 / 2]]];
OffsetGeneSet[k_:2, r_:1, offset_:1] := FromDigits[Mod[# + offset, k]& /@ Reverse[IntegerDigits[#, k, 2^(2 r)]], k]& /@ GeneSet[k, r];
GeneSets[k_:2, r_:1] := Prepend[OffsetGeneSet[k, r, #]& /@ Range[k - 1], GeneSet[k, r]];

Genealogy Trees

AncestorGraph[rule_, k_:2, r_:1] := Module[{graph = {}},
    If[r > 0,
        graph = Flatten[{{rule, r, RuleGenes[rule, k, r]} -> {#, r - 1 / 2, RuleGenes[#, k, r - 1 / 2]}& /@ RuleGenes[rule, k, r], AncestorGraph[#, k, r - 1 / 2]& /@ RuleGenes[rule, k, r]}]
        ,
        graph = {}
    ]; graph
];
AncestorGraphEvolution[rule_, k_:2, r_:1, init_:{{1}, 0}] := Module[{graph = {}},
    If[r > 0,
        graph = Flatten[{ArrayPlot[CellularAutomaton[{rule, k, r}, init, {50, {-50, 50}}], PlotLabel -> ToString[{rule, r}]] -> ArrayPlot[CellularAutomaton[{#, k, r - 1 / 2}, init, {50, {-50, 50}}], PlotLabel -> ToString[{#, r - 1 / 2}]]& /@ RuleGenes[rule, k, r], AncestorGraphEvolution[#, k, r - 1 / 2, init]& /@ RuleGenes[rule, k, r]}]
        ,
        graph = {}
    ]; graph
];