Version 1 of Graphs: Dijkstra animated demo

FF - 2009-01-31 - Yeah! This is the season of graphs! :-)

This program is an animated demonstration of Dijkstra's algorithm for finding the minimum cost path (a.k.a. shortest path) in a cyclic graph.

# Again, the procedures which add vertices and edges to canvas, and also in memory (array vertex, edge)

 proc addVertex {x y} {
        array set ::vertex {}
        if {![info exists ::seq]} {set ::seq 0}
        set ::vertex($::seq) [list $x $y]
        set r 9
        .c create oval \
                [expr {$x-$r}] [expr {$y-$r}] \
                [expr {$x+$r}] [expr {$y+$r}] \
                -fill green -outline black \
                -tags [list vertex vertex:$::seq]
        .c create text $x $y -text [expr {1+$::seq}] \
                -tags [list vertex_id vertex_id:$::seq]
        foreach tag [list vertex:$::seq vertex_id:$::seq] {
                .c bind $tag <ButtonPress-1> [list start $::seq]
        }
        return [expr {[incr ::seq]-1}]
 }

 proc addEdge {a b {bidi 1} {weight auto}} {
        array set ::edge {}
        if {$a == $b} {return}
        incr a -1 ; incr b -1
        set dx [expr {[lindex $::vertex($b) 0]-[lindex $::vertex($a) 0]}]
        set dy [expr {[lindex $::vertex($b) 1]-[lindex $::vertex($a) 1]}]
        .c create line \
                [lindex $::vertex($a) 0] [lindex $::vertex($a) 1] \
                [lindex $::vertex($b) 0] [lindex $::vertex($b) 1] \
                -width 1 -fill gray -tags [list edge edge:$a:$b]
        .c raise vertex
        .c raise vertex_id
        if {$weight == "auto"} {
                set weight [expr {sqrt($dx*$dx+$dy*$dy)}]
        }
        set ::edge($a:$b) $weight
        if $bidi {set ::edge($b:$a) $weight}
        if {$weight == 0} {return}
        .c create text \
                [expr {[lindex $::vertex($a) 0]+$dx/2}] \
                [expr {[lindex $::vertex($a) 1]+$dy/2}] \
                -text [expr {round($weight)}] -tags weight
 }

 proc adj v {
        set r {}
        foreach v [array names ::edge $v:*] {lappend r [lindex [split $v :] 1]}
        return $r
 }

# here's the algorithm itself

 proc dijkstra {s} {
        set T [array names ::vertex]
        set S [list]
        array set ::cost {}
        array set ::prev {}
        set cur $s

        lappend S $cur
        set T [lreplace $T [lsearch -exact $T $cur] [lsearch -exact $T $cur]]

        foreach v [adj $cur] {
                set ::cost($v) $::edge($cur:$v)
                set ::prev($v) $cur
        }

        set v_min -1
        while 1 {
                after 500
                updateState ; update 
                set stop 1
                foreach t $T {if {[info exists ::cost($t)]} {set stop 0; break}}
                if $stop {break}

                unset v_min
                foreach j $T {
                        if {![info exists ::cost($j)]} {continue}
                        if {![info exists v_min] || $::cost($j) <= $::cost($v_min)} {
                                set v_min $j
                        }
                }
                set cur $v_min

                lappend S $v_min
                set T [lreplace $T [lsearch -exact $T $v_min] [lsearch -exact $T $v_min]]
                if {[llength $T] == 0} {break}

                foreach i [adj $v_min] {
                        if {[lsearch -exact $T $i] < 0} {continue}
                        if {![info exists ::cost($i)] || $::cost($i) > [expr {$::cost($v_min)+$::edge($v_min:$i)}]} {
                                set ::cost($i) [expr {$::cost($v_min)+$::edge($v_min:$i)}]
                                set ::prev($i) $v_min
                        }
                }
        }
 }

# and the usual GUI stuff:

 proc updateState {} {
        .c itemconfigure edge -width 1 -fill gray
        .c delete cost
        foreach v [array names ::prev] {
                .c itemconfigure edge:$v:$::prev($v) -width 3 -fill red
                .c itemconfigure edge:$::prev($v):$v -width 3 -fill red
                .c create text \
                        [expr {[lindex $::vertex($v) 0]+12}] \
                        [expr {[lindex $::vertex($v) 1]-2}] \
                        -tags cost -fill red -text [expr {round($::cost($v))}] -anchor nw
        }
 }

 proc start {v} {
        catch {if $::working return}
        set ::working 1
        .c itemconfigure vertex -fill green
        .c itemconfigure vertex_id -fill black
        .c itemconfigure edge -width 1 -fill gray
        .c delete cost
        array unset ::cost
        array unset ::prev
        .c itemconfigure vertex:$v -fill black
        .c itemconfigure vertex_id:$v -fill white
        .c configure -cursor watch
        dijkstra $v
        .c configure -cursor {}
        set ::working 0
 }

 package require Tk
 pack [label .l -text "Click on a vertex to start Dijkstra's Shortest Path algorithm starting from there"]
 pack [canvas .c -width 600 -height 500 -background white]

 foreach {x y} {
  20 100 180 120 260  70  80  30  60 180 170  60 180 190 290 150
 370 200 420 110 300  10 410  30 510  80 300 240 120 260 490 190
 580 150 530 270 400 280  20 270  85 350 205 320 300 320 400 340
 540 350  30 430  95 470 190 415 350 450 490 415 570 460
 } {addVertex $x $y}

 foreach {a b} {
 10 12 1 4 1 5 1 2 1 6 5 7 2 7 2 6 2 3 7 8 3 8 4 11 9 11 6 3 2 8
 8 9 9 10 10 11 3 11 6 11 6 4 5 15 7 15 14 15 7 14 8 14 10 12 11 12
 10 13 12 13 14 19 9 19 9 16 10 16 19 16 19 18 16 18 16 17 10 16
 13 17 18 17 5 20 20 15 20 21 21 22 21 26 21 27 26 27 21 28 22 28
 22 23 23 24 24 29 30 25 30 31 14 23 24 25 28 29 30 29 17 31
 } {addEdge $a $b}