[Arjen Markus] (26 August 2002) A few years ago cellular automata were "in vogue": they formed a new type of mathematical objects that had rather interesting properties. Given a few simple rules, they could exhibit a wealth of structures. The most famous one of all: the Game of Life.

I recently came across them again and concocted this little script. If I remember the rules correctly, it is an implementation of the Game of Life.

The idea:
   * A cell gets a new state (0 or 1) depending on its own state and that of its neighbours.
   * In the case shown the rules are very simple: count the number of "live" neighbours. If it is even, then the new state of the centre cell becomes 0. Otherwise it becomes 1.

The rules are found in the proc newCellState.

Note: I paid little attention to customisation or presentation. Just watch and be fascinated.

----

 # cellular_automata --
 #    Implement simple two-dimensional cellular automata
 #

 # displayState --
 #    Display the current state
 # Arguments:
 #    window   Window to update
 #    cells    Cells array
 #    state    State array
 #    nocols   Number of columns
 #    norows   Number of rows
 # Result:
 #    None
 # Side effects:
 #    Display the new state by chnaging the colour of the cells
 #
 proc displayState { window cells state nocols norows } {
    upvar #0 $cells cellId
    upvar #0 $state newState 

    for { set j 0 } { $j < $norows } { incr j } {
       for { set i 0 } { $i < $nocols } { incr i } {
          $window itemconfigure $cellId($i,$j) \
             -fill [lindex {white black} $newState($i,$j)]
       }
    }
 } 

 # calculateNewState --
 #    Calculate the new state
 # Arguments:
 #    window     Window for display
 #    cells      Cell IDs
 #    old_state  State array holding current state
 #    new_state  State array holding new state
 #    nocols     Number of columns
 #    norows     Number of rows
 # Result:
 #    None
 # Side effects:
 #    Set new values in the array new_state
 #
 proc calculateNewState { window cells old_state new_state nocols norows  } {
    upvar #0 $old_state state
    upvar #0 $new_state newState
 
    for { set j 0 } { $j < $norows } { incr j } {
       for { set i 0 } { $i < $nocols } { incr i } {
          set ie [expr {$i+1} ]
          set iw [expr {$i-1} ]
          set jn [expr {$j+1} ]
          set js [expr {$j-1} ]
          set ie [expr {($ie >= $nocols) ? 0           : $ie} ]
          set iw [expr {($iw <  0      ) ? ($nocols-1) : $iw} ]
          set jn [expr {($jn >= $norows) ? 0           : $jn} ]
          set js [expr {($js <  0      ) ? ($norows-1) : $js} ]
          set newState($i,$j) \
             [newCellState $state($i,$j)  $state($iw,$j) \
                           $state($ie,$j) $state($i,$jn) \
                           $state($i,$js) ]
       }
    } 

    displayState $window $cells $new_state $nocols $norows

    #
    # Schedule this routine again - reversed arrays!
    #
    after 100 [list \
       calculateNewState $window $cells $new_state $old_state $nocols $norows ]
 }

 # setUpDisplay --
 #    Initialise the display
 # Arguments:
 #    window     The window used to display the result
 #    cells      Array with cell IDs
 #    nocols     Number of columns
 #    norows     Number of rows
 # Result:
 #    None
 # Side effects:
 #    Set new values in the array cells
 #
 proc setUpDisplay { window cells nocols norows } {
    upvar #0 $cells cellId

    for { set j 0 } { $j < $norows } { incr j } {
       for { set i 0 } { $i < $nocols } { incr i } {
          set iw [expr {10*$i} ]
          set ie [expr {$iw+9} ]
          set js [expr {10*($norows-$j)} ]
          set jn [expr {$js-9} ]
          set cellId($i,$j) \
             [$window create rectangle $iw $jn $ie $js -outline "" -fill white]
       }
    }
 }

 # newCellState --
 #    Determine the new state of a cell
 # Arguments:
 #    state_c    State of the current cell
 #    state_w    State of the cell west of the current cell
 #    state_e    State of the cell east of the current cell
 #    state_n    State of the cell north of the current cell
 #    state_s    State of the cell south of the current cell
 # Result:
 #    New state
 #
 proc newCellState { state_c state_w state_e state_n state_s } {
    set sum [expr {$state_w+$state_e+$state_n+$state_s}]

    switch -- $sum {
    "0" { set result 0 }
    "1" { set result 1 }
    "2" { set result 0 }
    "3" { set result 1 }
    "4" { set result 0 }
    default { set result 0 ;# Should never happen though }
    }

    return $result
 }

 # main --
 #    Steer the application
 # Arguments:
 #    None
 # Result:
 #    None
 # Note:
 #    It is necessary to use global arrays - because of [after]
 #
 proc main {} {
    canvas .cnv
    pack .cnv -fill both

    set norows 30
    set nocols 29

    setUpDisplay .cnv ::cells $nocols $norows

    #
    # Initial condition
    #
    for { set j 0 } { $j < $norows } { incr j } {
       for { set i 0 } { $i < $nocols } { incr i } {
          set ::state($i,$j) 0
       }
    }
    set ::state(5,5) 1

    displayState .cnv ::cells ::state $nocols $norows

    after 100 [list \
       calculateNewState .cnv ::cells ::state newState $nocols $norows ]
 }

 #
 # Start the program
 #
 main

----
[Category mathematics]