Version 8 of Graphs: BFS an DFS animated demo

Updated 2010-11-27 21:36:26 by Jorge

FF - 2009-01-30 - This program is an animated demonstration of BFS and DFS searches.

http://dev.gentoo.org/~mescalinum/tclwiki-img/graphanim.gif


# 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: