game of life

[saint_monkey]

dagoski spoke of a "game of life" last night, while we were all playing games to bring in the new year, he referred to it as a standard programming problem. i'd never heard of it. since you can't mention things like that around me without me going nuts, i had to look it up... the rules are here: http://www.tech.org/~stuart/life/rules.html

since i'm trying to build a portfolio of VBA examples for my SanFran job search someday, I thought I'd create my own solution. It's in VBA, and is under the cut. warning, only for the nerdy.
open an excel worksheet
choose tools>macro>Visual Basic Editor
in the VBE, Insert>Module
Paste in the code below:
alt-tab back to excel, and using the forms toolbar, (View>Toolbars>Forms) draw three buttons in column A. Assign "SetGen" to one, "SetPop" to the second and "SetZero" to the third.
to run, click the setpop button, it will populate the board with "living" cells or plug 1's into your own selected cells in b3:T21, then hit the setgen button to advance the state of life on the board by one generation.

what's the point? i'm not sure. after a while, things either get into a loop, they die, or go into stasis. all in all, a complete waste of time. perhaps this is the meaning of life?

---

'code begins

Sub Generation()

'The original article describing the game can be found
'in the April 1970 issue of Scientific American, page 120.

'the original game was set up on a "Go" board,
'which would be an board divided into 18 rows, and 18 columns.
'this macro assumes that there is a range of selected cells on the active
'excel worksheet. if you set "setGen" to a button, an 18x18 board will
'be selected automatically.
'RULES
'The Game of Life was invented by John Conway
'The game is played on a field of cells,
'each of which has eight neighbors (adjacent cells).
'A cell is either occupied (by an organism) or not.
'The rules for deriving a generation from the previous one are these:
'DEATH
'If an occupied cell has 0, 1, 4, 5, 6, 7, or 8 occupied neighbors,
'the organism dies (0, 1: of loneliness; 4 thru 8: of overcrowding).
'SURVIVAL
'If an occupied cell has two or three neighbors, the organism survives
'to the next generation.
'BIRTH
'If an unoccupied cell has exactly three occupied neighbors,
'it becomes occupied.
'The number of live neighbors is always based
'on the cell state BEFORE the rule was applied.

On Error Resume Next
Dim Arr()

rcount = Selection.Rows.Count
ccount = Selection.Columns.Count
'since life state can't be altered until all neighbors
'are polled, the obvious alternatives are to either
'use an array to store variables and
'offset the writing of cell values by 0x:-3y from the current cell
'(x being the horizontal axis, y being the vertical
'(perhaps a time saving solution for a gigantic board,
'since only 3 times y variables would need to be stored))
'or write all variables to a larger array (x times y) and loop back through
'the selection a second time and write the values

'i opted for option 2, since my board is small

'dimension a 2-D array for each position on the board
ReDim Arr(rcount, ccount)

'loop through all cells on the board
For Each Cell In Selection
Count = 0
Range(Cell.Address).Activate

'Poll Neighbors: add to count if adjacent cells are 'alive'
Count = Count + ActiveCell.Offset(1, -1).Value
Count = Count + ActiveCell.Offset(1, 0).Value
Count = Count + ActiveCell.Offset(1, 1).Value
Count = Count + ActiveCell.Offset(0, -1).Value
Count = Count + ActiveCell.Offset(0, 1).Value
Count = Count + ActiveCell.Offset(-1, -1).Value
Count = Count + ActiveCell.Offset(-1, 0).Value
Count = Count + ActiveCell.Offset(-1, 1).Value

'based on the poll, write the new state of life to an array postion
'i've reduced the rules above to:
'if the cell is alive, kill it if count is less than 2 and greater than 3
'if the cell is dead, make it alive if count is 3

If Cell.Value = 1 Then
Select Case Count
Case Is < 2
Arr((Cell.Row) - 3, (Cell.Column) - 2) = ""
Case Is > 3
Arr((Cell.Row) - 3, (Cell.Column) - 2) = ""
Case Else
Arr((Cell.Row) - 3, (Cell.Column) - 2) = 1
End Select
Else
Select Case Count
Case Is = 3
Arr((Cell.Row) - 3, (Cell.Column) - 2) = 1
Case Else
Arr((Cell.Row) - 3, (Cell.Column) - 2) = ""
End Select
End If
Next Cell

'now that each cell's new value has been determined
'we need to loop back through the board and set
'each cell's condition to the new state of life.
For Each Cell In Selection
rval = Cell.Row - 3
cval = Cell.Column - 2
Range(Cell.Address).Value = Arr(rval, cval)
Select Case Cell.Value
Case 1
Range(Cell.Address).Interior.ColorIndex = 3
Case 0
Range(Cell.Address).Interior.ColorIndex = None
End Select
Next Cell
'update the generation count
Range("B1").Value = Range("B1").Value + 1
End Sub

Sub Populate()
'populate the selected range at random with either a one or nothing.
Selection.Clear
For Each Cell In Selection
intPlussor = Int((1 - 0 + 1) * Rnd + 0)
test = Cell.Value + intPlussor
Select Case test
Case "1"
Cell.Value = test
Range(Cell.Address).Interior.ColorIndex = 3
Case "0"
Cell.Value = ""
Range(Cell.Address).Interior.ColorIndex = None
End Select
Next Cell
Range("B1").Value = "1"
End Sub

Sub ZeroAll()
'clear the board, reset the generation count
For Each Cell In Selection
Range(Cell.Address).Value = ""
Range(Cell.Address).Interior.ColorIndex = None
Next Cell
Range("B1").Value = 0
End Sub

Sub SetGen()
'made to be assigned to a button
'set the size of the board, get the cells to a
'nice width for viewing, and call the generation macro
'altering the board size can occur here without messing up
'the generation macro's code.
Range("B3:T21").Select
Selection.RowHeight = 13.2
Selection.ColumnWidth = 1.22
Range("B1:T1").MergeCells = True
Call Generation
End Sub

Sub SetPop()
'made to be assigned to a button
'set the size of the board, get the cells to a
'nice width for viewing, and call the population macro
Range("B3:T21").Select
Selection.RowHeight = 13.2
Selection.ColumnWidth = 1.22
Call Populate
End Sub

Sub SetZero()
'made to be assigned to a button
'set the size of the board, get the cells to a
'nice width for viewing, and call the zeroall macro
Range("B3:T21").Select
Selection.RowHeight = 13.2
Selection.ColumnWidth = 1.22
Call ZeroAll
End Sub

'code ends