I solved on May 2020 this using mma . I am aware of this command - Cellular automata. But I can't use it on this challenge, because there's no concept of "Torus" in the CellularAutomaton . So the function CellularAutomaton is difficult to use in these conditions, we have to build our own functions from the workspace 11x11. So below is how i did the solution of the example" which is the core of the problem", and my question is whether it can be done with fewer lines of code (and maybe use the CellularAutomaton function if possible).
$\begingroup$
$\endgroup$
Add a comment
|
3 Answers
$\begingroup$
$\endgroup$
5
This method is a modified version of the Game of Life example from the Neat Examples section of SparseArray.
I changed the cellupdate function so that a cell is born if it has 1 or 2 neighbors, and stays alive if it has 3 neighbors. The modified update function tests only the cells with common edges.
ClearAll[cellupdate,update]
SetAttributes[cellupdate,Listable];
cellupdate[0,1]=cellupdate[0,2]=1;
cellupdate[1,3]=1;
cellupdate[_,_]=0;
update[m_]:=cellupdate[m,
Sum[RotateRight[m,r],{r,{{-1,0},{0,-1},{0,1},{1,0}}}]]
init = SparseArray[{{6, 6} -> 1}, {11, 11}]
s=init;
ArrayPlot[#,ImageSize->50,Mesh->True]&/@
Prepend[Table[s=update[s];s=SparseArray[s],{16}],init]
Edit (CellularAutomaton version):
ArrayPlot[#,ImageSize->50,Mesh->True]&/@
CellularAutomaton[<|"Neighborhood"->"VonNeumann",
"GrowthSurvivalCases"->{{1,2},{3}}|>,
SparseArray[{{6,6}->1},{11,11}],
16]
-
-
$\begingroup$ This was the example to resolve the challenge: "find rules for our version of the game and an initial input on an 11x11 torus board that will lead, after at least 100,000 generations, to a 72-long cycle". I find a rule and initial input solution that will lead, after 153,719 generations, to a 72-long cycle. $\endgroup$ Commented Jul 4, 2020 at 21:28
-
$\begingroup$ creidhne, How simple and informative, with the CellularAutomation function, When I see my ladle program, I feel ridiculous! Anyway, I say at least it worked. Are you interested in continuing the real question of the challange? $\endgroup$ Commented Jul 4, 2020 at 22:41
-
1$\begingroup$ @Reda.Kebbaj, Your program is the do-it-yourself approach, and impressive for that reason. I'll check the challenge puzzle, maybe work on it later. $\endgroup$– creidhneCommented Jul 4, 2020 at 23:45
-
$\begingroup$ My question is completely answered, namely: 1 the possibility of using the cellularAutomatr function 2 to optimize the code. It's so beautiful how it was simplified. Tanks @creidhne . $\endgroup$ Commented Jul 5, 2020 at 7:31
$\begingroup$
$\endgroup$
Description Program : The code is using 3 modules after the Intialisation: 1- Torus module 2- Rules module: 3- Excution Module: n generation module using Torus and Rules modules.
Initialisations :
n = 16;
Init = {{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}};
1- Torus Module :
Torus[matrix_]:=Module[{InitM=matrix},
M={};
M1={};Dim=Dimensions[InitM][[1]]+2;
M=Insert[#,0,{{1},{-1}}]&/@InitM;
M1=Insert[InitM[[1]],0,{{1},{-1}}];
M=Insert[M,M1,{{1},{-1}}];
M[[Dim]]=M[[2]];
M[[1]]=M[[Dim-1]];
M=Reverse/@Transpose[M];
M[[Dim]]=M[[2]];
M[[1]]=M[[Dim-1]];
M=Reverse/@Transpose[Reverse/@Transpose[Reverse/@Transpose[M]]]];
2- Rules Module:
Rules[matrix_, c1_, c2_, c3_] := Module[{p = matrix, cont1 = c1, cont2 = c2, cont3 = c3},
R = R2 = {}; Dim = Dimensions[p][[1]];
For[k = 2, k <= Dim - 1, k++,
For[i = 2, i <= Dim - 1, i++, t = 0;
s = p[[k + 1]][[i]] + p[[k - 1]][[i]] + p[[k]][[i - 1]] +
p[[k]][[i + 1]];
If[p[[k]][[i]] == 1 && s == cont1, t = 1; Goto[next]];
If[p[[k]][[i]] == 0 , If[s == cont2 || s == cont3, t = 1]];
Label[next]; AppendTo[R, t]]; AppendTo[R2, R]; R = {}]; R2];
3- Excution Module:
sec = {}; AppendTo[sec, Init]; Init = Torus[Init]; c = 1;
While[c <= n, Init = Torus[Rules[Init, 3, 2, 1]];
AppendTo[sec, R2]; c++];
ArrayPlot[#, ImageSize -> 50, Mesh -> True] & /@ sec
$\begingroup$
$\endgroup$
Representing n generations: n=16, and the workspace imposed in the puzzle as a (11 $\times$ 11) matrix such that all the live cells are represented by 1 and the dead ones by 0. Also in this particular case for the example we have: "the rules 01100;00010 mean that a cell is born if it has one or two neighbors, and stays alive if it has three. If we start with a single cell in the middle of an 11x11 torus board, then after 15 generations, you will have an alternating chess-like pattern, and after 16 steps, just the four corners".
- [Here is the code that solves the example given by the puzzel]
n = 16;
Init = {{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0},
{0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0}};
Torus[matrix_] := Module[{InitM = matrix}, M = {}; M1 = {};Dim = Dimensions[InitM][[1]] + 2;M = Insert[#, 0, {{1}, {-1}}] & /@ InitM; M1 = Insert[InitM[[1]], 0, {{1}, {-1}}]; M = Insert[M, M1, {{1}, {-1}}]; M[[Dim]] = M[[2]]; M[[1]] = M[[Dim - 1]]; M = Reverse /@ Transpose[M]; M[[Dim]] = M[[2]]; M[[1]] = M[[Dim - 1]]; M = Reverse /@ Transpose[Reverse /@ Transpose[Reverse /@Transpose[M]]]];
Rules[matrix_, c1_, c2_, c3_] := Module[{p = matrix, cont1 = c1, cont2 = c2, cont3= c3}, R = R2 = {}; Dim = Dimensions[p][[1]]; For[k = 2, k <= Dim - 1, k++, For[i = 2, i <= Dim - 1, i++, t = 0; s = p[[k + 1]][[i]] + p[[k - 1]][[i]] + p[[k]][[i - 1]] + p[[k]][[i + 1]]; If[p[[k]][[i]] == 1 && s == cont1, t = 1; Goto[next]]; If[p[[k]][[i]] == 0 , If[s == cont2 || s == cont3, t =1]]; Label[next]; AppendTo[R, t]]; AppendTo[R2, R]; R = {}]; R2];
sec = {}; AppendTo[sec, Init]; Init = Torus[Init]; c = 1; While[c <= n, Init = Torus[Rules[Init, 3, 2, 1]]; AppendTo[sec, R2]; c++]; ArrayPlot[#, ImageSize -> 50, Mesh -> True] & /@ sec
- [which gives after the execution of the code this:]*
- *"after 15 generations, you will have an alternating chess-like pattern, and after 16 steps, just the four corners"
