Updated 2013-01-20 08:37:26 by pooryorick ▲

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!

Heuristic Searches

Category Concept