# How to optimally solve and generalize this Conway's Game of Life puzzle

I tried solving this using mma. I am aware of this command - Cellular automata. But i don't want to use that coz then there is no challenge. So below is how i did it and my question is can this be done with fewer lines of code (without resorting to CellularAutomaton). Also i wanted to generalize it to any initial condition.

I am representing the grid shown in the puzzle as a (n $\times$ m) matrix such that all the live cells are represented by 1 and the dead ones by 0. Also in this particular case we have $n = 26$ and $m = 27$. Then i manually made a list of the initial condition given in the question. Here each pair represents the $(ij)^{th}$ element having live cells.

• [as a side note - can this process be automated - i mean finding this list from that image given for the intial grid by some image processing]
list = {{2, 6}, {2, 13}, {3, 23}, {3, 25}, {4, 3}, {4, 10},
{4, 9}, {4, 18}, {5, 18}, {5, 2}, {8, 11}, {8, 12},
{10, 10}, {10, 12}, {11, 11}, {12, 18}, {13, 2}, {14, 2}, {13,
23}, {14, 8}, {14, 23}, {16, 24}, {17, 25}, {18, 24},
{18, 18}, {18, 17}, {19, 12}, {20, 12}, {20, 3}, {20, 4}, {22,
24}, {23, 23}, {22, 17}, {23, 18}};


The matrix $A_{n \times m}$ now contains the elements 1 and 0 corresponding to the live and dead cells receptively.
$f^{ij}_{0}$ contains the $(ij)^{th}$ element of $A_{n \times m}$

  A[n_, m_] := SparseArray[# -> 1 & /@ list, {n, m}, 0]

Table[f[i, j] = A[26, 27][[i, j]], {i, 1, 26}, {j, 1, 27}];


The recursive function which gives the next generation is:-

f[k_][i_, j_] := f[k][i, j] = Module[{n = 26, m = 27, neg},

findNeighbours[i, j] := Module[{},
f[k - 1][#[], #[]] & /@ {{i - 1, j - 1}, {i - 1,
j}, {i - 1, j + 1}, {i, j - 1}, {i, j + 1}, {i + 1,
j - 1}, {i + 1, j}, {i + 1, j + 1}}];

neg = Cases[findNeighbours[i, j], _Integer];

(* Apply the rules to the ij th element*)
Which[f[k - 1][i, j] == 1,
Which[Count[neg, 1] < 2,
val = 0, (Count[neg, 1] === 2 || Count[neg, 1] === 3), val = 1,
Count[neg, 1] > 3, val = 0],
f[k - 1][i, j] == 0,
Which[Count[neg, 1] === 3, val = 1, True, val = 0]]

]


Finally we can plot the results to see the answer which is 3 if the starting generation is called $1^{st}$ generation.

   genaration =
ArrayPlot[
Table[f[i, j] = A[26, 27][[i, j]], {i, 1, 26}, {j, 1, 27}], Mesh -> True];

genaration[n_] :=
ArrayPlot[Table[f[n][i, j], {i, 1, 26}, {j, 1, 27}], Mesh -> True]

res = ListAnimate[genaration[#] & /@ Range[0, 3],
AnimationRate -> 0.5] My "Game of Life" implementation:

a = RandomInteger[BernoulliDistribution[0.1], {200, 200}];

Dynamic[Image[a =
1 - Unitize[(# - 3) (# - 12) (# - 13)] &@
ListConvolve[{{1, 1, 1}, {1, 10, 1}, {1, 1, 1}}, a, {2, 2}, 0]
]] To use the initial grid in the question you would just initialise a with:

a = SparseArray[list -> 1]


However my code continuously updates the grid (quite rapidly), so the grid evolves to the "all dead" state in a fraction of a second.

To actually answer the question "how many generations have any life in them" you could write the evolution step as a function and use FixedPointList to count the number of steps:

evolve[a_] := 1 - Unitize[(# - 3) (# - 12) (# - 13)] &@
ListConvolve[{{1, 1, 1}, {1, 10, 1}, {1, 1, 1}}, a, {2, 2}, 0]

Length@FixedPointList[evolve, Normal[SparseArray[list -> 1]]] - 2
(* 3 *)


Note that FixedPointList will generate the complete list of grids, so for larger problems you would want to use a different approach to avoid eating all your computer's memory.

• honestly i really don't understand this fully. care to put some comments. like how would i implement this for the initial grid as given in the puzzle. – Hubble07 Feb 11 '14 at 18:34

This is one way of implementing Conway's Game of Life:

step[matrix_] := Module[{m = matrix, neighbours},
neighbours = ListConvolve[{{1, 1, 1}, {1, 0, 1}, {1, 1, 1}}, ArrayPad[m, 1]];
m = ReplacePart[m, Position[neighbours, _?(# == 1 || # > 3 &)] -> 0];
m = ReplacePart[m, Position[neighbours, 3] -> 1]
]


For example, this is the so called glider:

m = ArrayPad[{{0, 1, 0}, {0, 0, 1}, {1, 1, 1}}, {1, 10}];
ListAnimate[ArrayPlot[#, Mesh -> True] & /@ NestList[step, m, 30]] I've written about another cellular automata problem here and this includes a link to a post where image processing was used in Mathematica to get initial states for a cellular automata problem, so the answer to that question is that yes it is possible.

• really liked the way ListConvolve is used. such a powerful command. Thanks – Hubble07 Feb 11 '14 at 18:40