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
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
No comments:
Post a Comment