[FF] - 2009-01-30 - This program is an animated demonstration of BFS and DFS searches. [bfsScreenshot] ---- # 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} { 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} { set v {} set q [list $s] set bfsseq 0 while {$q != {}} { set pop [lindex $q 0] set q [lrange $q 1 end] foreach adj [adj $pop] { if {[lsearch -exact $v $adj] < 0} { lappend q $adj } } if {[lsearch -exact $v $pop] < 0} { lappend v $pop visit $pop [incr bfsseq] update after 400 } } } # also the DFS is non-recursive, but uses a stack (also implemented with plain lists) to store vertices to visit proc dfs {s} { set v {} set q [list $s] set dfsseq 0 while {$q != {}} { set pop [lindex $q 0] set q [lrange $q 1 end] foreach adj [adj $pop] { if {[lsearch -exact $v $adj] < 0} { set q [linsert $q 0 $adj] } } if {[lsearch -exact $v $pop] < 0} { lappend v $pop visit $pop [incr dfsseq] update after 400 } } } # 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 {} { .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 ---- 11/27/2010 [JM] I had to add the following as the first line of the "addVertex" proc to make it work: if {![info exists ::seq]} {set ::seq 0} ---- See also: * [Graphs: Dijkstra animated demo] * [Graph theory in Tcl] * [More graph theory] <> Animation | Graph Theory | Mathematics