This page explores the use of Tcl for searching a state space from a problem. I define a GeneralSearch algorithm in Tcl, and then go on to define BreadthFirst and DepthFirst searches. Later, I might add heuristic search methods such as A*, iterative deepening etc. Finally, I demonstrate a simple example. - NEM
Note - see Searching A Star in Space for much better code by RS - NEM
################################################################################
# Some general search strategies in Tcl.
#
################################################################################
catch {console show}
# Let's first implement our node:
proc createNode {name operator state pathCost} {
puts "Creating node at $state as a result of $operator -> $pathCost"
set name2 [split $name |]; # use | as a path seperator.
set parent [string range $name 0 [expr {[string last "|" $name] - 1}]]
if {$operator == "starting"} {
set parent "Dummy"
} else {
set parent [${parent}::getState]
}
namespace eval $name [subst {
variable parent $parent
variable this $name
variable operator $operator
variable pathCost $pathCost
variable depth [llength $name2]
variable state $state
}]
proc ${name}::getState {} {
variable state
return $state
}
proc ${name}::getPathCost {} {
variable pathCost
return $pathCost
}
proc ${name}::getParent {} {
variable parent
return $parent
}
return $name
}
# We will implement the queue as a list.
proc MakeQueue {initState} {
set queue [list [createNode "rootNode" "starting" $initState 0]]
return $queue
}
proc RemoveFront {n} {
upvar 1 $n nodes
set front [lindex $nodes 0]
set nodes [lreplace $nodes 0 0]
return $front
}
# The problem will be an array of the form:
# problem(initState) - initial state
# problem(goalTest) - the ideal state (i.e. the goal)
# problem(operators) - the operators of the problem
proc Expand {node operators} {
# Apply all operators to node and return a list
# of new nodes.
set returnNodes {}
set uniqueName 1
foreach operator $operators {
set name $node
append name "|node$uniqueName"
set res [eval $operator $node]
if {![string equal $res "Error"]} {
foreach item $res {
lappend returnNodes [eval createNode $name $operator $item]
incr uniqueName
set name $node
append name "|node$uniqueName"
}
}
}
return $returnNodes
}
# All other functions are defined by the particular search.
proc GeneralSearch {p QueuingFunc} {
upvar 1 $p problem
set nodes [MakeQueue $problem(initState)]
while {[llength $nodes] > 0} {
puts "Continue?"
if {[string equal [gets stdin] "n"]} {
exit
}
set currentNode [RemoveFront nodes]
puts "$nodes"
set result [eval $problem(goalTest) [${currentNode}::getState]]
if {$result == 1} {
return $currentNode
} else {
puts "->Expanding [${currentNode}::getState]"
set res [Expand $currentNode $problem(operators)]
if {[string length $res] == 0} {
puts "No nodes expanded."
continue
}
$QueuingFunc $res nodes
}
}
return -code error "Goal not found"
}
################################################################################
# To define a new search, you can use the building blocks above.
# For instance, let's define breadth-first and depth-first:
#
################################################################################
proc BreadthFirstSearch {p} {
# First, define our queuing function.
upvar 1 $p problem
proc EnqueueAtEnd {newNodes q} {
upvar 1 $q queue
set queue [concat $queue $newNodes]
return
}
return [GeneralSearch problem EnqueueAtEnd]
}
proc DepthFirstSearch {p} {
upvar 1 $p problem
proc EnqueueAtFront {newNodes q} {
upvar 1 $q queue
set queue [concat $newNodes $queue]
return
}
return [GeneralSearch problem EnqueueAtFront]
}
################################################################################
# To define a search problem you simply do the following:
# * Define your problem with an initial state of some sort (a string in this case)
# * Define the goal test as a procedure in the following form:
# proc goalTest {state} {
# # Work out if goal here
# return 1 for success
# return 0 for failure
# }
# * A list of operators in the form:
# proc operator1 {node} {
# return [list newState pathCost]
# }
# * The operators are resposible for deciding new states and calculating the pathCost
# to this new state.
#
#
# A simple example:
# Search a maze for the quickest route.
# This was a coursework assignment I had a while back.
################################################################################
# The problem:
# Find your way from A to U in the following maze.
# | ============\
# | A B C D E |
# | |==|== | |
# | F |G |H I |J |
# | | |== | |
# | K L M N |O |
# | |==|==| | |
# | P |Q |R |S |T |
# |===| | |==| |
# | U V W X Y |
# | |===========/
# We apply the restrictions that no move can go back to the start state, and no
# move can go back to the state it was _just_ at (i.e. the direct parent state).
################################################################################
# First, define our stateSpace. For this search, the stateSpace is known
# but the procs would still work if your operators can get information from other
# sources. It is easier though, if we just give them the info in the first place :-)
# The state-space here consists of nodes followed by a list stating which
# directions are possible and what the path cost is and what the destination is.
array set map {
A {e 1 B s 1 F}
B {w 1 A e 1 C}
C {w 1 B e 1 D}
D {w 1 C e 1 E s 1 I}
E {w 1 D s 1 J}
F {n 1 A s 1 K}
G {s 1 L}
H {e 1 I}
I {n 1 D w 1 H s 1 N}
J {n 1 E s 1 O}
K {n 1 F e 1 L s 1 P}
L {n 1 G w 1 K e 1 M}
M {w 1 L e 1 N}
N {n 1 I w 1 M s 1 S}
O {n 1 J s 1 T}
P {n 1 K}
Q {s 1 V}
R {s 1 W}
S {n 1 N}
T {n 1 O s 1 Y}
U {e 1 V}
V {n 1 Q w 1 U e 1 W}
W {n 1 R w 1 V e 1 X}
X {w 1 W e 1 Y}
Y {n 1 T w 1 X}
}
set stateSpace(initState) "A"
proc GoalTest {state} {
if {[string equal $state "U"]} {
return 1
} else {
return 0
}
}
set stateSpace(goalTest) GoalTest
proc moveNorth {node} {
# Check if node can move north, if it can
# return the list, else return ""
set moves $::map([${node}::getState])
set result "Error"
set parent [${node}::getParent]
foreach {dir cost newState} $moves {
if {[string equal $dir "n"] && ![string equal $newState $parent]} {
# We have a winner!
set pathCost [expr {[${node}::getPathCost] + $cost}]
set result [list $newState $pathCost]
}
}
return $result
}
proc moveEast {node} {
# Check if node can move north, if it can
# return the list, else return ""
set moves $::map([${node}::getState])
set result "Error"
set parent [${node}::getParent]
foreach {dir cost newState} $moves {
if {[string equal $dir "e"] && ![string equal $newState $parent]} {
# We have a winner!
set pathCost [expr {[${node}::getPathCost] + $cost}]
set result [list $newState $pathCost]
}
}
return $result
}
proc moveWest {node} {
# Check if node can move north, if it can
# return the list, else return ""
set moves $::map([${node}::getState])
set result "Error"
set parent [${node}::getParent]
foreach {dir cost newState} $moves {
if {[string equal $dir "w"] && ![string equal $newState $parent]} {
# We have a winner!
set pathCost [expr {[${node}::getPathCost] + $cost}]
set result [list $newState $pathCost]
}
}
return $result
}
proc moveSouth {node} {
# Check if node can move north, if it can
# return the list, else return ""
set moves $::map([${node}::getState])
set result "Error"
set parent [${node}::getParent]
foreach {dir cost newState} $moves {
if {[string equal $dir "s"] && ![string equal $newState $parent]} {
# We have a winner!
set pathCost [expr {[${node}::getPathCost] + $cost}]
set result [list $newState $pathCost]
}
}
return $result
}
# These operators are all basically the same, but they could be wildly different in real life.
set stateSpace(operators) [list moveNorth moveEast moveWest moveSouth]
# you could change the order to see if it makes a difference. On uninformed strategies it will
# change the order of search, but the outcome should still be the same, if the search is optimal &
# complete.
# Now we search:
puts "Depth First Search:\n==================="
catch {DepthFirstSearch stateSpace} result
set result [split $result "|"]
puts "$result"
set route [lindex $result 0]
puts -nonewline "[${route}::getState] -> "
set result [lrange $result 1 end]
foreach item $result {
append route "|$item"
puts -nonewline "[${route}::getState] -> "
}
puts "End!"
puts "Total cost: [${route}::getPathCost]"
puts "\nBreadth First Search:\n====================="
catch {DepthFirstSearch stateSpace} result
set result [split $result "|"]
puts "$result"
set route [lindex $result 0]
puts -nonewline "[${route}::getState] -> "
set result [lrange $result 1 end]
foreach item $result {
append route "|$item"
puts -nonewline "[${route}::getState] -> "
}
puts "End!"
puts "Total cost: [${route}::getPathCost]"
And that should do it! Just copy and paste into tclsh or wish console and watch it whirl!