>
**Introduction**
[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.
''Remark:'' as noted below by [DKF] the rules are definitely not those of Life.
However, it is rather dynamic :)
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.
**Program 1**
----
======
# cellular_automata --
# Implement simple two-dimensional cellular automata
#
package require Tk
# 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
======
----
''[DKF]'' - This is not the classic rules for Conway's Life.
That uses the eight nearest neighbours (diagonal too), and states that a cell will remain in its current state when it is next to two living neighbours, become/remain alive when it is next to three living neighbours, and become/remain dead when it is next to any other number of neighbours ("overcrowding" and "loneliness", if you will.)
Please see later in this page for Conway in Tcl...
**WireWorld**
''[DKF]'' - There are other interesting categories of cellular automata. < >
One of my favourites is "wires" where each cell can be in one of four states:
blank: Always remains blank.
wire: Becomes a head if-and-only-if next (using 8 neighbours rule) to one or two heads.
head: Becomes a tail.
tail: Becomes a wire.
This is not quite as dynamic as Life (the rules keep the overall form by-and-large static) but it is computationally complete (note that heads and tails combine to form pulse chains that travel in definite directions):
"3-cycle Pulse Source"
H############ ->
T
"OR Gate"
-> #####
#
############ ->
#
-> #####
"INHIBIT Gate"
-> ########## ####### ->
#
###
#
-> ##########
(The inhibit input)
It's possible to build complex "circuits" using this, though layout is tricky because you have to be very careful about the timing.
----
**[Langton's Ant]**
Langton's Ant is an automaton that wanders around blindly for a while,
before getting its act together and heading off determinedly in a particular direction.
To make its life marginally more interesting, this Ant lives on a toroid,
so it keeps tripping over its own tracks.
There is some background at [http://mathworld.wolfram.com/LangtonsAnt.html].
======
# lant.tcl Langton's Ant
set size 400 ;# pixels per canvas side
set side 400 ;# cells per canvas side
set cell [expr $size/$side] ;# pixels per cell
set bgcol yellow
set fgcol red
set adir(0) {1 0};set adir(1) {0 1};set adir(2) {-1 0};set adir(3) {0 -1}
catch {destroy .c}
canvas .c -width [expr $size+1] -height [expr $size+1] -bg $bgcol
bind .c