Showing posts with label breadth first search tcl. Show all posts
Showing posts with label breadth first search tcl. Show all posts

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