Updated 2015-12-13 13:53:50 by arjen

Arjen Markus (8 december 2015) Cellular automata are a marvelously simple tool to model all manner of complex phenomena. Or perhaps better: to construct a simple system that exhibits remarkably complex phenomena that have some resemblance to actual physical, chemical and biological systems. The most famous one is probably the Game of Life invented by James Conway. Here is another one: a Greenburg-Hastings model that can be used to simulate "excitable systems". I was led to this model in search of some information on the Belousov-Zhabotinksy reaction, where the reactants are involved in reversible reactions and because of the differences in colour produce unexpected evolving patterns, all in a simple Petri dish.

The GUI presented by the code below has a few quirks, it seems a good exercise in OO to get the global state and the reaction of the various buttons in perfect shape. Right now, it will do most of what is supposed to (except restart when the grid size is changed) by means of a bunch of global variables. Well, I was more interested in the dynamics of the graphics yesterday evening.

Anyway, enjoy!

AM (13 december 2015) I changed the colours on advice by "adrian". The pastel colours do give it a look that is easier on the eye.
# greenberg_hastings.tcl --
#     Implementation of a cellular automaton according to Greenberg-Hastings
#
#     The rules are simple:
#     - There are three states, 0, 1 and 2
#     - If the cell has state 1, it goes to state 2
#     - If the cell has state 2, it goes to state 0
#     - If the cell has state 0 and at least neighbour has state 1,
#       it goes to state 1. Otherwise it remains in state 0
#
proc newState {state} {
    set ny [llength $state]
    set nx [llength [lindex $state 0]]
    set newstate $state

    for {set y 0} {$y < $ny} {incr y} {
        set ym1 [expr {$y != 0      ? $y - 1 : $ny - 1}]
        set yp1 [expr {$y != $ny -1 ? $y + 1 : 0}]
        for {set x 0} {$x < $nx} {incr x} {
            set cell [lindex $state $y $x]

            set xm1 [expr {$x != 0      ? $x - 1 : $nx - 1}]
            set xp1 [expr {$x != $nx -1 ? $x + 1 : 0}]

            if { $cell == 0 } {
                if { [lindex $state $ym1 $x] == 1 } { set cell 1 }
                if { [lindex $state $yp1 $x] == 1 } { set cell 1 }
                if { [lindex $state $y $xm1] == 1 } { set cell 1 }
                if { [lindex $state $y $xp1] == 1 } { set cell 1 }
            } elseif { $cell == 1 } {
                set cell 2
            } else {
                set cell 0
            }
            lset newstate $y $x $cell
        }
    }

    return $newstate
}

proc displayState {state index} {
    set ny [llength $state]
    set nx [llength [lindex $state 0]]

    for {set y 0} {$y < $ny} {incr y} {
        for {set x 0} {$x < $nx} {incr x} {
            set cell [lindex $state $y $x]

            #.c itemconfigure [lindex $index $y $x] -fill [lindex {yellow lime lightblue} $cell]
            .c itemconfigure [lindex $index $y $x] -fill [lindex {#8dd3c7 #ffffb3 #bebada} $cell]

        }
    }
}

proc runAutomation {start} {
    global initialised
    global width
    global height
    global index
    global state
    global cols
    global rows
    global pause

    if { $start } {
        set initialised 1
        set state [lrepeat $rows [lrepeat $cols 0]]

        set rmax [expr {int(rand()*11)}]
        for {set r 0} {$r < $rmax} {incr r} {
            set x [expr {int(rand()*($cols-1))}]
            set y [expr {int(rand()*($rows-1))}]
            set p [expr {int(rand()*3)}]

            if { $p == 0 } {
                lset state [expr {$y+0}] [expr {$x+0}] 1
                lset state [expr {$y+0}] [expr {$x+1}] 2
                lset state [expr {$y+1}] [expr {$x+0}] 0
                lset state [expr {$y+1}] [expr {$x+1}] 0
            }

            if { $p == 1 } {
                lset state [expr {$y+0}] [expr {$x+0}] 2
                lset state [expr {$y+0}] [expr {$x+1}] 0
                lset state [expr {$y+1}] [expr {$x+0}] 1
                lset state [expr {$y+1}] [expr {$x+1}] 1
            }

            if { $p == 2 } {
                lset state [expr {$y+0}] [expr {$x+0}] 0
                lset state [expr {$y+0}] [expr {$x+1}] 1
                lset state [expr {$y+1}] [expr {$x+0}] 2
                lset state [expr {$y+1}] [expr {$x+1}] 2
            }
        }

        set dx    [expr {$width / $cols}]
        set dy    [expr {$height / $rows}]
        set index $state

        for {set y 0} {$y < $rows} {incr y} {
            for {set x 0} {$x < $cols} {incr x} {
                set x1 [expr {$dx * $x}]
                set x2 [expr {$dx * ($x+1)-1}]
                set y1 [expr {$dy * $y}]
                set y2 [expr {$dy * ($y+1)-1}]
                lset index $y $x [.c create rectangle $x1 $y1 $x2 $y2 -fill white -outline #b0b0b0]
            }
        }
    } else {
        set state [newState $state]
    }

    displayState $state $index

    if { ! $pause } {
        after $::delay {
            runAutomation 0
        }
    } else {
         set pause 0
    }
}

proc pauseAutomation {} {
    global pause

    set pause 1
}

proc stepAutomation {} {
    global pause
    global initialised

    set pause 1

    if { ! $initialised } {
        runAutomation 1
    } else {
        runAutomation 0
    }
}

# main --
#     Set up the window
#
set initialised 0
set width  800
set height 800
set cols   30
set rows   30
set pause  0
set delay  200

frame .frame
grid [canvas .c -width $width -height $height -bg white] .frame -sticky news

grid [::ttk::label .frame.header  -text "Size of the grid" -font "Helvetica 12 bold"]         - -sticky w
grid [::ttk::label .frame.columns -text Columns] [entry .frame.columnNumber -textvariable cols] -sticky news -pady 2
grid [::ttk::label .frame.rows    -text Rows]    [entry .frame.rowNumber -textvariable rows]    -sticky news -pady 2

grid [::ttk::label .frame.header2 -text "Commands" -font "Helvetica 12 bold"]  - -sticky w -pady {20 2}
grid [::ttk::button .frame.run    -text "Run"      -command {runAutomation 1}] - -sticky news -padx 20 -pady 2
grid [::ttk::button .frame.step   -text "One step" -command stepAutomation]    - -sticky news -padx 20 -pady 2
grid [::ttk::button .frame.pause  -text "Pause"    -command pauseAutomation]   - -sticky news -padx 20 -pady 2
grid [::ttk::button .frame.exit   -text "Exit"     -command exit]              - -sticky news -padx 20 -pady 20