[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 event [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) $path

Demo code prints dots in places of path.

See also: 
   * [finding the shortest paths in a graph]
   * [a lightweight digraph package] (contains A* and other searches)
   * [Heuristic Searches]
   * [Searching A star in space]

----
!!!!!!
%| [Category Algorithm] | [Category Graph theory] | [Category AI] |%
!!!!!!