count = 0;
rules = {
({
{0, 0},
{0, 0}
}) -> ({
{0, 0},
{0, 0}
}), ({
{1, 0},
{0, 0}
}) -> ({
{0, 0},
{1, 0}
}), ({
{0, 1},
{0, 0}
}) -> ({
{0, 0},
{0, 1}
}), ({
{1, 1},
{0, 0}
}) -> ({
{0, 0},
{1, 1}
}),
({
{0, 0},
{1, 0}
}) -> ({
{0, 0},
{1, 0}
}), ({
{1, 0},
{1, 0}
}) -> ({
{0, 0},
{1, 1}
}), ({
{0, 1},
{1, 0}
}) -> ({
{0, 0},
{1, 1}
}), ({
{1, 1},
{1, 0}
}) -> ({
{1, 0},
{1, 1}
}),
({
{0, 0},
{0, 1}
}) -> ({
{0, 0},
{0, 1}
}), ({
{1, 0},
{0, 1}
}) -> ({
{0, 0},
{1, 1}
}), ({
{0, 1},
{0, 1}
}) -> ({
{0, 0},
{1, 1}
}), ({
{1, 1},
{0, 1}
}) -> ({
{0, 1},
{1, 1}
}),
({
{0, 0},
{1, 1}
}) -> ({
{0, 0},
{1, 1}
}), ({
{1, 0},
{1, 1}
}) -> ({
{1, 0},
{1, 1}
}), ({
{0, 1},
{1, 1}
}) -> ({
{0, 1},
{1, 1}
}), ({
{1, 1},
{1, 1}
}) -> ({
{1, 1},
{1, 1}
})
};
nextgen0[m_] := Block[{a, c}, c = Flatten@Table[
a = (({
{m[[i, j]], m[[i, j + 1]]},
{m[[i + 1, j]], m[[i + 1, j + 1]]}
}) /. rules); {{i, j} -> a[[1, 1]], {i, j + 1} ->
a[[1, 2]], {i + 1, j} -> a[[2, 1]], {i + 1, j + 1} ->
a[[2, 2]]},
{i, 1, Dimensions[m][[1]] - 1, 2}, {j, 1,
Dimensions[m][[2]] - 1, 2}
];
Table[{i, j} /. c
, {i, Dimensions[m][[1]]}
, {j, Dimensions[m][[2]]}
]
];
nextgen[m_] := If[count++; Mod[count, 2] == 0,
nextgen0[m]
,
Block[{last, mt},
last = Last[m];
mt = m[[;; -2]];
Join[
Map[#[[3 ;; -3]] &,
(moveforward[nextgen0[movebackward[
PadRight[PadLeft[mt, Dimensions[mt] + {2, 2}],
Dimensions[mt] + {4, 4}]
]]]
)[[3 ;; -3]]]
,
{last}
]
]
];
moveforward[m_] := Transpose[RotateRight[Transpose[RotateRight[m]]]];
movebackward[m_] := Transpose[RotateLeft[Transpose[RotateLeft[m]]]];
m = Table[
If[((i - 14)^2 + (j - 10)^2 < 4^2) ||
i < 20 - 16 Exp[-(j - 10)^2/(800/25)], 0, 1], {i, 20}, {j, 20}];
gens = NestList[nextgen, m, 30];
ListAnimate[ArrayPlot /@ gens]