Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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]
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement