How to encode this rule (for visualization, etc) similar to cellular automata?

Question

I came across this rule on Twitter and it reminded me of the cellular automota discussed in NKS:

How to encode this in Mathematica for (visual) inspection?

Answer 1

First of all I recommend reading this chapter of NKS book:

https://www.wolframscience.com/nks/p82--substitution-systems

It is a SubstitutionSystem, so you can simply do:

SubstitutionSystem[{"0" -> "01", "1" -> "10"}, "0", 5]

{"0", "01", "0110", "01101001", "0110100110010110", "01101001100101101001011001101001"}

For a different visual you can also do any symbols:

SubstitutionSystem[{"○"->"○■","■"->"■○"},"■",5]//Column

Or, you can use lists and go a bit more elaborate to get the look similar to CellularAutomaton:

ArrayPlot[
Module[
    {pad, data=SubstitutionSystem[{0->{0,1},1->{1,0}},{0},7]},
    pad=Length/@{data,Last[data]};
    PadRight[data,pad]
],
Mesh->All,PlotRangePadding->None]

Answer 2

This implements your first method, generating your sequence up to iteration 4:

NestList[Flatten[# /. {0 -> {0, 1}, 1 -> {1, 0}}] &, {0}, 3]

(* Out: {{0}, {0, 1}, {0, 1, 1, 0}, {0, 1, 1, 0, 1, 0, 0, 1}} *)

---

This implements your second method, generating 4 terms of your sequence:

NestList[#~Join~(# /. {0 -> 1, 1 -> 0}) &, {0}, 3]

(* Out: {{0}, {0, 1}, {0, 1, 1, 0}, {0, 1, 1, 0, 1, 0, 0, 1}} *)

---

This implements your third method, based on the binary representation of $n$, and returns one digit of the sequence at a time:

ClearAll[nthterm]
nthterm[n_Integer] := Last@IntegerDigits[Total@IntegerDigits[n, 2], 2]
nthterm /@ Range[0, 10]

(* Out: {0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0} *)

---

In the cases implemented using NestList, you can use just Nest instead if you want just the $n^{th}$ term.