3
$\begingroup$

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).

$\endgroup$
4
$\begingroup$

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]

modified game of life

Edit (CellularAutomaton version):

ArrayPlot[#,ImageSize->50,Mesh->True]&/@
    CellularAutomaton[<|"Neighborhood"->"VonNeumann",
      "GrowthSurvivalCases"->{{1,2},{3}}|>,
    SparseArray[{{6,6}->1},{11,11}],
  16]
| improve this answer | |
$\endgroup$
  • $\begingroup$ Tanks, I really like! $\endgroup$ – Reda.Kebbaj Jul 4 at 20:55
  • $\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$ – Reda.Kebbaj Jul 4 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$ – Reda.Kebbaj Jul 4 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$ – creidhne Jul 4 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$ – Reda.Kebbaj Jul 5 at 7:31
1
$\begingroup$

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
| improve this answer | |
$\endgroup$
0
$\begingroup$

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:]* enter image description here
  • *"after 15 generations, you will have an alternating chess-like pattern, and after 16 steps, just the four corners"
| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.