Googie 2008-07-14 - A-star (aka A*) is a shortest path finding algorithm.
Implementation below (based on book 'Developing Games in Java' by David Brackeen, Bret Barker, Laurence Vanhelsuwe) is done usign Itcl, maybe there is someone who could get it done with TclOO or even pure-Tcl. It would be nice. Since Itcl is enough for me I don't bother with other implementations.
package require Itcl
namespace import itcl::*
class AStarNode {
constructor {x y cost} {
set _x $x
set _y $y
set _myCost $cost
}
private {
variable _x ""
variable _y ""
variable _myCost ""
}
public {
variable pathParent ""
variable costFromStart 0.0
variable estimatedCostToGoal 0.0
method getCostNoArg {} {
return [expr {$costFromStart + $estimatedCostToGoal}]
}
# Gets the cost between this node and the specified
# adjacent (aka "neighbor" or "child") node.
method getCost {args} {
if {$args == ""} {
return [getCostNoArg]
}
set node [lindex $args 0]
return [$node getYourCost]
}
# Gets the estimated cost between this node and the
# specified node. The estimated cost should never exceed
# the true cost. The better the estimate, the more
# efficient the search.
method getEstimatedCost {node} {
set dx [$node getX]
set dy [$node getY]
set cost [expr {sqrt(($_x - $dx)**2 + ($_y - $dy)**2)}]
}
# Gets the children (aka "neighbors" or "adjacent nodes")
# of this node.
method getNeighbors {} {
set list [list]
foreach {x y} [list \
[expr {$_x - 1}] [expr {$_y - 1}] $_x [expr {$_y - 1}] [expr {$_x + 1}] [expr {$_y - 1}] \
[expr {$_x - 1}] $_y [expr {$_x + 1}] $_y \
[expr {$_x - 1}] [expr {$_y + 1}] $_x [expr {$_y + 1}] [expr {$_x + 1}] [expr {$_y + 1}] \
] {
if {[info exists ::nodeAt($x:$y)]} {
lappend list $::nodeAt($x:$y)
}
}
return $list
}
method getYourCost {} {
return $_myCost
}
method getX {} {
return $_x
}
method getY {} {
return $_y
}
}
}
# A simple priority list, also called a priority queue.
# Objects in the list are ordered by their priority.
# The highest priority item is first in the list.
class PriorityList {
private {
variable list ""
}
public {
method add {object} {
for {set i 0} {$i < [llength $list]} {incr i} {
if {[$object getCost] <= [[lindex $list $i] getCost]} {
set list [linsert $list $i $object]
return
}
}
lappend list $object
}
method isEmpty {} {
return [expr {[llength $list] == 0}]
}
method removeFirst {} {
set toRet [lindex $list 0]
set list [lreplace $list 0 0]
return $toRet
}
method remove {node} {
set idx [lsearch $list $node]
if {$idx > -1} {
set list [lreplace $list $idx $idx]
}
}
method contains {node} {
return [expr {$node in $list}]
}
}
}
proc constructPath {node} {
set path [list]
while {[$node cget -pathParent] != ""} {
set path [linsert $path 0 $node]
set node [$node cget -pathParent]
}
return $path
}
# Find the path from the start node to the end node. A list
# of AStarNodes is returned, or null if the path is not
# found.
proc findPath {startNode goalNode} {
set openList [PriorityList #auto]
set closedList [list]
$startNode configure -costFromStart 0
$startNode configure -estimatedCostToGoal [$startNode getEstimatedCost $goalNode]
$startNode configure -pathParent ""
$openList add $startNode
while {![$openList isEmpty]} {
set node [$openList removeFirst]
if {$node == $goalNode} {
# construct the path from start to goal
return [constructPath $goalNode]
}
set neighbors [$node getNeighbors]
foreach neighborNode $neighbors {
set isOpen [$openList contains $neighborNode]
set isClosed [expr {$neighborNode in $closedList}]
set costFromStart [expr {[$node cget -costFromStart] + [$node getCost $neighborNode]}]
if {$costFromStart < [$neighborNode cget -costFromStart]} {
if {$isClosed} {
set idx [lsearch $closedList $neighborNode]
if {$idx > -1} {
set closedList [lreplace $closedList $idx $idx]
}
}
if {$isOpen} {
$openList remove $neighborNode
}
}
# check if the neighbor node has not been
# traversed or if a shorter path to this
# neighbor node is found.
if {!$isOpen && !$isClosed} {
$neighborNode configure -pathParent $node
$neighborNode configure -costFromStart $costFromStart
$neighborNode configure -estimatedCostToGoal [$neighborNode getEstimatedCost $goalNode]
$openList add $neighborNode
}
}
lappend closedList $node
}
# no path found
return "";
}
#
# Demo
#
set mapY 0
proc createMapRow {args} {
set x 0
foreach arg $args {
set ::nodeAt($x:$::mapY) [AStarNode ::#auto $x $::mapY $arg]
incr x
}
incr ::mapY
}
proc prettyPathPrint {start path} {
foreach p $path {
puts "cost [$p getX]:[$p getY] = [$p getYourCost]"
}
for {set row 0} {$row < 8} {incr row} {
for {set col 0} {$col < 8} {incr col} {
set node $::nodeAt($col:$row)
if {$node in $path || $node == $start} {
puts -nonewline .\t
} else {
puts -nonewline [$node getYourCost]\t
}
}
puts ""
}
}
createMapRow 1 1 1 1 1 1 1 1
createMapRow 1 1 1 1 1 1 1 1
createMapRow 1 100 100 100 100 100 1 1
createMapRow 1 1 1 100 1 1 1 1
createMapRow 1 1 1 100 1 1 1 1
createMapRow 1 1 1 100 1 100 3 1
createMapRow 1 1 1 100 1 1 1 1
createMapRow 1 1 1 100 1 1 1 1
# Start at x:y = 2:4 and finish at x:y = 5:6
set path [findPath $nodeAt(2:4) $nodeAt(5:6)]
prettyPathPrint $nodeAt(2:4) $path
# Reset
set mapY 0
array unset ::nodeAt
createMapRow 1 1 1 1 1 1 1 1
createMapRow 1 1 100 100 100 100 1 1
createMapRow 1 1 1 1 1 100 1 1
createMapRow 1 1 1 1 1 100 1 1
createMapRow 1 1 1 1 1 100 1 1
createMapRow 1 1 1 1 1 100 1 1
createMapRow 1 1 100 100 100 100 1 1
createMapRow 1 1 1 1 1 1 1 1
# Start at x:y = 0:4 and finish at x:y = 6:4
set path [findPath $nodeAt(0:4) $nodeAt(6:4)]
prettyPathPrint $nodeAt(0:4) $pathDemo code prints dots in places of path.
See also: