Monday, April 1, 2013

Breadth First Search In TCL

I searched the web for a bfs code and could not find one in tcl that is easy so came up with this one .


bfs.tcl
---------

set visited [list]
set START "0"
set END "5"
set nonodes 6
set graph(0) {}

proc printpath visited {

set path ""
foreach node $visited {
lappend path $node  
}
puts $path
}
proc initgraph { cnt } {

global graph
for {set i 0} {$i < $cnt } { incr i } {
set graph($i) {}
}
}
proc addedge { node1 node2 } {

global graph

set adjacent $graph($node1)
lappend adjacent $node2
set graph($node1) $adjacent
}

proc isconnected { node1 node2 } {

global graph

set adjacent $graph($node1)
return [lsearch -exact $adjacent $node2]
}

proc getadjacentnodes { node1 } {

global graph
return $graph($node1)
}

proc breadthfirstsearch { visited } {

global END START
set nodes [getadjacentnodes [lindex $visited end]]

for {set i 0} {$i < [llength $nodes] } { incr i } {

set node [lindex $nodes $i]
set b [lsearch -exact $visited $node]
if { $b == 1} {
continue
}
set b [string compare $node $END]
if { $b == 0} {
lappend visited $node
printpath $visited

set visited [lreplace $visited [expr [llength $visited]-1] [expr [llength $visited]-1]]
break
}
}
for {set i 0} {$i < [llength $nodes] } { incr i } {

set node [lindex $nodes $i]
set b1 [lsearch -exact $visited $node]
set b2 [string compare $node $END]
if { $b1 == 1  ||  $b2 == 0 } {
continue;
}
lappend visited $node
breadthfirstsearch $visited
set visited [lreplace $visited [expr [llength $visited]-1] [expr [llength $visited]-1]]
}
}

initgraph $nonodes

addedge "0" "1"
addedge "1" "2"
addedge "1" "3"
addedge "1" "4"

addedge "2" "5"
addedge "3" "5"
addedge "4" "5"
addedge "1" "5"

set visited [list $START]

breadthfirstsearch $visited