Introduction

For the past two weeks, I have worked on a project to visualize one-dimensional neighbor-dependent substitution systems. In neighbor-dependent substitution systems, a single cell or series of cells is replaced by another block of cells, depending on the color of the initial cell(s) and the colors of the cells surrounding the cell(s) being replaced. Since this project deals with systems in one dimension, the neighboring cells are the ones directly to the left and to the right of each cell being replaced. If a cell is an "edge" cell, the side that is not surrounded by another cell is assumed to be touching a white cell. During these past two weeks, I learned how to program and write functions in Mathematica, which I used to create my project. The result of this project is a demonstration that shows the patterns created by one-dimensional neighbor-dependent substitution systems after various steps.

Creating the Sets of Substitution Rules

To create the various sets of substitution rules, I created a table of the 8 possible configurations that consist of three cells (the cell being replaced and the two surrounding cells) and another table containing the 4 possible 2-celled outcomes. Each cell can either be black (corresponding to the number 1) or white (corresponding to the number 0).

8 Possible Configurations:

oldcond = Tuples[{0, 1}, 3]

4 Possible Substitutions:

newcond = Tuples[{0, 1}, 2]

Then, I created another table containing all 65,536 possible rule sets and split the table into each set of rules.

replacements = Flatten[Table[old -> new, {old, oldcond}, {new, newcond}], 1];
newreplacements = Split[replacements, First[#1] === First[#2] &];
allrulesets = 
  Flatten[Table[{rule1, rule2, rule3, rule4, rule5, rule6, rule7, 
     rule8}, {rule1, newreplacements[[1]]}, {rule2, 
     newreplacements[[2]]}, {rule3, newreplacements[[3]]}, {rule4, 
     newreplacements[[4]]}, {rule5, newreplacements[[5]]}, {rule6, 
     newreplacements[[6]]}, {rule7, newreplacements[[7]]}, {rule8, 
     newreplacements[[8]]}], 7];

Writing the Function for the Substitution System

Next, I wrote a function that defines the rules to be followed by the substitution system. To replace each cell with a new block of two cells, the function will "look" at the cell and its two surrounding cells, and match this block of three cells to the one in the set of rules. Then, it would replace the block of three cells with a block of two cells colored according to the rules. In order to use this function, the number of the rule set and the initial cell must be specified by the user, because the function uses these two values as variables.

Step[start_List,rulenum_Integer]:=Flatten[Partition[ArrayPad[start, 1], 3, 1]//. Extract[allrulesets,rulenum]]

Then, I wrote 4 different functions that described the output of each step in the substitution system. The first function showed the cells aligned in the center as a pyramid-like shape, the second one showed each step aligned to the left, the third one showed the steps aligned to the right, and the last one showed the series of steps as a subdivided system.

Centered:

PatternSS[rulenum_Integer,init_List,steps_Integer]:=Block[{patt},
       patt=Rest@NestList[Step[#,rulenum]&,init,steps];
       Table[ArrayPad[patt[[n]],(2^steps-2^n)/2],{n,1,steps}]
       ]

Left-Aligned:

PatternSSLeft[rulenum_Integer,init_List,steps_Integer]:=Block[{patt},
       patt=NestList[Step[#,rulenum]&,init,steps];
       Table[ArrayPad[patt[[(n+1)]], {0,(2^steps - 2^n)}], {n,0,steps}]
       ]

Right-Aligned:

PatternSSRight[rulenum_Integer,init_List,steps_Integer]:=Block[{patt},
       patt=NestList[Step[#,rulenum]&,init,steps];
       Table[ArrayPad[patt[[(n+1)]], {(2^steps - 2^n),0}], {n,0,steps}]
       ]

Subdivided:

PatternSSSub[rulenum_Integer, init_List, steps_Integer] := Block[{patt},
     patt = NestList[Step[#, rulenum] &, init, steps];
     Partition[Flatten[Table[Flatten[patt[[(n + 1)]]] /. {1 -> Table[1, 2^(steps - n)], 0 -> Table[0, 2^(steps - n)]}, {n, 0, steps}], 2], 2^steps]
        ]

Creating the Manipulate Function for the Substitution System

Finally, I wrote the Manipulate functions for each of the substitution systems, with the rule number, initial cell, and number of steps as variables. The Manipulate function calls on the corresponding substitution system function and allows the user to select the rule number, initial cell, and the number of steps shown.

Centered:

Manipulate[
         ArrayPlot[PatternSS[rulenum, init, steps], Frame-> False, PixelConstrained-> 10],
         {{rulenum,1,"Rule Number"}, 1, 65536, 1},
         {{init, {0},"Initial Cell"}, {{0}->"White",{1}->"Black"}, ControlType -> RadioButtonBar}, 
         {{steps, 1, "Number of Steps"}, 1, 10, 1}, 
         ContentSize->{1300,170}, Alignment-> Center
         ]

Left-Aligned:

Manipulate[
         ArrayPlot[PatternSSLeft[rulenum, init, steps], Frame-> False, PixelConstrained-> 10],
         {{rulenum,1,"Rule Number"}, 1, 65536, 1},
         {{init, {0},"Initial Cell"}, {{0}->"White",{1}->"Black"}, ControlType -> RadioButtonBar}, 
         {{steps, 1, "Number of Steps"}, 1, 10, 1}, 
         ContentSize->{1300,170}, Alignment-> Left
         ]

Right-Aligned:

Manipulate[
            ArrayPlot[PatternSSRight[rulenum, init, steps], Frame-> False, PixelConstrained-> 10],
         {{rulenum,1,"Rule Number"}, 1, 65536, 1},
         {{init, {0},"Initial Cell"}, {{0}->"White",{1}->"Black"}, ControlType -> RadioButtonBar}, 
         {{steps, 1, "Number of Steps"}, 1, 10, 1}, 
         ContentSize->{1300,170}, Alignment-> Right
         ]

Subdivided:

Manipulate[
            ArrayPlot[PatternSSSub[rulenum, init, steps], Frame -> False, PixelConstrained -> 10],
       {{rulenum, 22226, "Rule Number"}, 1, 65536, 1},
       {{init, {1}, "Initial Cell"}, {{0} -> "White", {1} -> "Black"}, ControlType -> RadioButtonBar}, 
       {{steps, 7, "Number of Steps"}, 1, 10, 1}, 
       ContentSize -> {1300, 170}, Alignment -> Center, SaveDefinitions -> True
       ]

Interesting Patterns

These are some images of the interesting patterns found in the substitution systems.

Final Product

The final product of this project is a demonstration of the subdivided substitution system in the form of a Wolfram Demonstration. In addition, the notebook containing the code in this post is attached.

Acknowledgements

I would like to thank my mentor Dariia Porechna for helping me with this project, and all the mentors and instructors at the Wolfram High School Summer Camp for being wonderful teachers. I have learned so much valuable information over the past two weeks and I will treasure my time at the camp!

Attachments: