2 added 1120 characters in body
source | link

I'm curious how you generated the original CA image for rule 150R. I'm not sure that it can be handled by the built in CellularAutomaton command since it's second order. Here's one approach that generates the image in NKS quite closely:

rule = {{0, 1, 0}, {1, 1, 1}};
T = 10;
rSize = 2^T;
init = {1};
init = Join[Table[0, {rSize}], init, Table[0, {rSize}]];
init = Table[0, {2*rSize + 1}];
init[[rSize + 1]] = 1;
init = {Table[0, 2^(T + 1) + 1], init};
init1 = {0};
init2 = {1};
init = {
  Join[Table[0, {rSize}], init1, Table[0, {rSize}]],
  Join[Table[0, {rSize}], init2, Table[0, {rSize}]]
};
step[{list2_, list1_}] := {list1, Mod[
    rule[[1, 1]]*RotateLeft[list2] + rule[[1, 2]]*list2 + 
    rule[[1, 3]]*RotateRight[list2] +
    rule[[2, 1]]*RotateLeft[list1] + rule[[2, 2]]*list1 + 
    rule[[2, 3]]*RotateRight[list1],2]};
evo = Last /@ NestList[step, init, rSize];
ArrayPlot[evo]

enter image description here

The obvious difference is that this image is triangular, growing the way we expect a CA to grow.


I'm curious how you generated the original CA image for rule 150R. I'm not sure that it can be handled by the built in CellularAutomaton command since it's second order. Here's one approach that generates the image in NKS quite closely:

rule = {{0, 1, 0}, {1, 1, 1}};
T = 10;
rSize = 2^T;
init = {1};
init = Join[Table[0, {rSize}], init, Table[0, {rSize}]];
init = Table[0, {2*rSize + 1}];
init[[rSize + 1]] = 1;
init = {Table[0, 2^(T + 1) + 1], init};
init1 = {0};
init2 = {1};
init = {
  Join[Table[0, {rSize}], init1, Table[0, {rSize}]],
  Join[Table[0, {rSize}], init2, Table[0, {rSize}]]
};
step[{list2_, list1_}] := {list1, Mod[
    rule[[1, 1]]*RotateLeft[list2] + rule[[1, 2]]*list2 + 
    rule[[1, 3]]*RotateRight[list2] +
    rule[[2, 1]]*RotateLeft[list1] + rule[[2, 2]]*list1 + 
    rule[[2, 3]]*RotateRight[list1],2]};
evo = Last /@ NestList[step, init, rSize];
ArrayPlot[evo]

enter image description here

The obvious difference is that this image is triangular, growing the way we expect a CA to grow.

1
source | link

It looks to me like you're not really generating the rule 150R; you're highlighting the complement. As such, it's not really a self-similar set, just as the complementary intervals of the Cantor set don't form a self-similar set. Nonetheless, it can be generated with a recursive procedure - though, in this case, it's a second order recursion, just as rule 150R is second order.

Let's begin with a base image:

Clear[step];
color[1] = LightPurple;
right1 = {
   {{0, 0}, {4, -4}, {6, -2}, {2, 2}},
   {{4, -4}, {2, -6}, {4, -8}, {6, -6}},
   {{0, -6}, {1, -7}, {2, -6}, {1, -5}}
   };
base = Join[right1, Map[#*{-1, 1} &, right1, {2}]];
step[1] = {color[1], EdgeForm[Black], Polygon[base]};
Graphics[step[1]]

enter image description here

As the recursion is second order, we need a second image before we begin the recursion.

color[2] = LightOrange;
mid = Map[2*# - {0, 12} &, base, {2}];
right2 = Translate[Rotate[step[1], -Pi/2, {0, 0}], {20, -20}];
left2 = Translate[Rotate[step[1], Pi/2, {0, 0}], {-20, -20}];
step[2] = {
   {color[2], EdgeForm[Black], Polygon[mid]},
   {step[1], right2, left2}
   };
Graphics[step[2]]

enter image description here

Note that we've taken the original base image, scaled it up by the factor 2, shifted it down and recolored it. We've also added two more copies of step 1 on the side while retaining the original step 1 for a total of 3 copies of step 1. That's almost the general procedure for generating step $n$ from steps $n-1$ and step $n-2$. In general, step $n$ will consist of 1 copy of the original base (with a new color) scaled up by the factor $2^{n-1}$, 3 copies of step $n-1$, and 2 copies of step $n-2$. The overall recipe, expressed recursively, is as follows:

color[3] = LightBlue;
color[4] = LightGreen;
color[n_] := Lighter[ColorData[1][n - 4], 0.9] /; n > 4;

step[n_] := step[n] = Module[
    {mid, left, right, innerTop, innerBot},
    mid = Map[2^(n - 1)*# - {0, 6 (2^n - 2)} &, base, {2}];
    right = Translate[Rotate[step[n - 1], 
        -Pi/2, {0, 0}], {4(2^(n+1)-3), -4(2^(n+1)-3)}
    ];
    left = Translate[Rotate[step[n - 1], 
        Pi/2, {0, 0}], {-4(2^(n+1)-3), -4(2^(n+1)-3)}
    ];
    innerTop = Translate[step[n - 2], {0, -6*2^n}];
    innerBot = Translate[Rotate[step[n - 2], 
        Pi, {0, 0}], {0, -24*(2^(n - 1) - 1)}
    ];
    {{color[n], EdgeForm[Directive[Black, Opacity[0.7]]], Polygon[mid]}, 
     {step[n - 1], right, left, innerTop, innerBot}}];
Grid[Partition[Table[Graphics[step[n], ImageSize -> 300], {n, 3, 6}], 2]]

enter image description here

I'm not really sure how the color scheme should go so I just used an Indexed color set. We can generate something like the Cellular Automaton image by setting the polygon colors all to white. That is, set color[n_]=White and rerun with $n=8$ to get:

enter image description here