** Description ** [FF] - 2009-01-30 - This program is an animated demonstration of BFS and DFS searches. [bfsScreenshot] ** Changes ** [JM] 2010-11-27: fixed "::seq": no such variable" error in addVertex ** Code ** ====== # Some GUI stuff (canvas and buttons) package require Tk canvas .c -width 600 -height 500 -background white grid .c -row 0 -column 0 -columnspan 3 button .bfs -text "BFS" -command {enable 0; bfs 0; enable 1} button .rst -text "Reset" -command {reset} button .dfs -text "DFS" -command {enable 0; dfs 0; enable 1} grid .bfs .rst .dfs -row 1 # I used an array for storing vertices and another array for storing edges. # I keep x,y positions inside the vertices array, just a sa convenience (I'm thinking of doing another demo on weighted graphs, and the position could be used to automatically calculate the weight across nodes) # the edges are stored in the array, as a unique key $a:$b where $a and $b are the vertex identifiers # the addEdge proc can make both directed and undirected edges, and accepts a weight argument (if 'auto' it will compute the weight from $x,$y position of the vertex proc addVertex {x y} { 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] return [expr {[incr ::seq]-1}] } proc addEdge {a b {bidi 1} {weight auto}} { if {$a == $b} {return} set dx [expr {[lindex $::vertex($b) 0]-[lindex $::vertex($a) 0]}] set dy [expr {[lindex $::vertex($b) 1]-[lindex $::vertex($a) 1]}] set ::edge($a:$b) $weight if $bidi {set ::edge($b:$a) $weight} .c create line \ [lindex $::vertex($a) 0] [lindex $::vertex($a) 1] \ [lindex $::vertex($b) 0] [lindex $::vertex($b) 1] \ -fill gray .c raise vertex .c raise vertex_id if {$weight == "auto"} { set weight [expr {sqrt($dx*$dx+$dy*$dy)}] } elseif {$weight == 0} { return } .c create text \ [expr {[lindex $::vertex($a) 0]+$dx/2}] \ [expr {[lindex $::vertex($a) 1]+$dy/2}] \ -text [expr {int($weight)}] } # getting the adjacent vertices (very easy). note that I preprocess the results by splitting on the ':' character used in the array key proc adj v { set r {} foreach v [array names ::edge $v:*] {lappend r [lindex [split $v :] 1]} return $r } # the BFS is non-recursive, and uses a queue (implemented with plain lists) to store the vertices to visit: proc bfs {s {v {}}} { variable busy set bfsseq 0 if {$s != {}} { set pop [lindex $s 0] set s [lrange $s 1 end] foreach adj [adj $pop] { if {[lsearch -exact $v $adj] < 0} { lappend s $adj } } if {[lsearch -exact $v $pop] < 0} { lappend v $pop visit $pop [incr bfsseq] set wait 400 } else { set wait 0 } set busy [after $wait [list after idle [list [namespace current]::bfs $s $v]]] } } # also the DFS is non-recursive, but uses a stack (also implemented with plain lists) to store vertices to visit proc dfs {s {v {}}} { variable busy set dfsseq 0 if {$s != {}} { set pop [lindex $s 0] set s [lrange $s 1 end] foreach adj [adj $pop] { if {[lsearch -exact $v $adj] < 0} { set s [linsert $s 0 $adj] } } if {[lsearch -exact $v $pop] < 0} { lappend v $pop visit $pop [incr dfsseq] set wait 400 } else { set wait 0 } set busy [after $wait [list after idle [list [namespace current]::dfs $s $v]]] } } # the visit consists of just visually marking the vertex, and showing the time of visit (sequential number) proc visit {s seq} { .c itemconfigure vertex:$s -fill black .c itemconfigure vertex_id:$s -fill white .c create text \ [expr {10+[lindex $::vertex($s) 0]}] [lindex $::vertex($s) 1] \ -text $seq -fill blue -anchor w -tags visit } # other GUI stuff follows: proc reset {} { variable busy after cancel $busy .c delete visit .c itemconfigure vertex -fill green .c itemconfigure vertex_id -fill black } proc enable {b} { if $b {set b active} {set b disabled} foreach w {.bfs .dfs .rst} {$w configure -state $b} } proc initGraph {x y} { set Q 150 ; set off 0 for {set h 0} {$h < 3} {incr h} { set t [expr {$h*atan(1)*8.0/3}] set xx [expr {$x+cos($t+atan(1)*6)*$Q}] set yy [expr {$y+sin($t+atan(1)*6)*$Q}] set R {25 50 80 120} ; set O {0.5 0.5 1.5 1.5} for {set n 0} {$n < [llength $R]} {incr n} { set r [lindex $R $n] ; set o [lindex $O $n] for {set i 0} {$i < 5} {incr i} { set t [expr {$i*atan(1)*8.0/5}] set xxx [expr {$xx+cos($t+atan(1)*$o*4)*$r}] set yyy [expr {$yy+sin($t+atan(1)*$o*4)*$r}] addVertex $xxx $yyy } } for {set j 0} {$j < 5} {incr j} { foreach {z1 z2 w} {0 0 1 0 5 0 10 15 0 15 15 1 5 10 3 5 10 2} { addEdge [expr {$z1+$off+$j}] [expr {$z2+$off+($j+$w)%5}] 1 0 } } incr off 20 } addEdge 19 55 1 0 ; addEdge 16 35 1 0 } initGraph 300 290 ====== ** See Also ** * [Graphs: Dijkstra animated demo] * [Graph theory in Tcl] * [More graph theory] <> Animation | Graph Theory | Mathematics