## A* Pathfinding Library

For community projects only.
JosephE
Posts: 5
Joined: Wed Mar 26, 2008 2:39 am

### A* Pathfinding Library

Here's freely available functions for implementing the A* (A-Star, Astar) path finding algorithm in games or whatever you need it for.

Should be fairly straightforward to implement. If you need help just shoot JosephE a pm on the just basic forums.

If you have improvements just post below.

Thanks to tsh73, cassiope01 (especially), and DaveG for their help!

EDIT: Updated code a tad to clean up and avoid possible bugs. Replaced the display function with the one Stefan posted below. Thanks Stefan!

EDIT:
Thanks to cassiope01 again, it seems to now find the shortest path! (with a major delay in speed, however)

Oh, and thanks stefan for the tip! It now uses spaces instead of Ascii 0.

EDIT:
We were close, but it wasn't quite finding the shortest path. So cassiope and I have updated it to this! Thanks cassiope! And it also is faster on my computer by about half a second. http://justbasic.conforums.com/index.cg ... 1274378779

Code: Select all

``````' Required for pathfinding library:
Dim Con(0,0)
Dim Path(0,0)
Dim Path.Open.X(0)   ' Open List
Dim Path.Open.Y(0)
Dim Path.Open.ParentX(0)
Dim Path.Open.ParentY(0)
Dim Path.Open.Cost(0)
Dim Path.Open.PCost(0)
Dim Path.Closed.X(0) ' Closed list
Dim Path.Closed.Y(0)
Dim Path.Closed.ParentX(0)
Dim Path.Closed.ParentY(0)
Global Path.Width, Path.Height
Global Path.StartX, Path.StartY
Global Path.EndX, Path.EndY
Global Path.Closed, Path.Open ' The number of items in
'   the open and closed list
' -------------------------------------------------------------------------------------------- '

worldWidth = 26
worldHeight = 16

' Let's make our own world.
' Each row 26 characters long and there are 16 rows:

world\$ = _
"                          ";_ ' 1
"                          ";_ ' 2
"                          ";_ ' 3
"   +++++++                ";_ ' 4
"   +    +                 ";_ ' 5
"     +  +                 ";_ ' 6
"   + + a+    +         +  ";_ ' 7
"   ++++++++++ +       +   ";_ ' 8
"           +   +     +    ";_ ' 9
"  +++++++++     +++++     ";_ ' 10
"           +              ";_ ' 11
"            +++++         ";_ ' 12
"                +  ++++++ ";_ ' 13
"                ++        ";_ ' 14
"                +   +  b  ";_ ' 15
"                +  +++    "   ' 16

start = Time\$("ms")
test = Path.Find(s\$)
print "time: "; (time\$("ms") - start)
Print "result: ";test
Call Path.Print
End

' To get to the location.
' The coordinates placed in answer\$ are like this:
' XX_YY XX_YY ... and so on.

' So you could get them by:
' cord1x = Val(Word\$(cord1\$,1,"_"))
' cord1y = Val(Word\$(cord1\$,2,"_"))

Dim Dir.X(4)
Dim Dir.Y(4)

Dir.X(1) = 0  : Dir.Y(1) = -1 ' Up
Dir.X(2) = 1  : Dir.Y(2) = 0  ' Right
Dir.X(3) = -1 : Dir.Y(3) = 0  ' Left
Dir.X(4) = 0  : Dir.Y(4) = 1  ' Down

' Start at the start location.
x = Path.StartX : y = Path.StartY

ppp = 0

' Put the starting location on the closed list:
Call Path.ClosedPush Path.StartX, Path.StartY,0,0

Do

For i = 1 To 4
' Check all the directions:

nextX = x + Dir.X(i)
nextY = y + Dir.Y(i)

If Path(nextX,nextY) = 32 Then ' Square is open...so...

' Calculate the cost of the neighboring square:
cost = ppp + Abs(Path.EndX - nextX) + Abs(Path.EndY - nextY)

If nextX = Path.EndX And nextY = Path.EndY Then
' Arrived at destination
success = 1
GoTo [GetOut]
Else
' Haven't arrived at our destination:
If Not(Path.IsClosed(nextX, nextY)) Then
' Current square isn't on the closed list
isOpen = Path.IsOpen(nextX,nextY) ' If the box is in the open list, this is the array index to the box's values.
If Not(isOpen) Then
' Path isn't on the open list, so we push it in there
Call Path.OpenPush nextX,nextY,x,y,cost,ppp
' (x,y) is the parent location for the new open list item: (nextX,nextY)
Else
' Path is on the open list, so we compare costs.
If cost < Path.Open.Cost(isOpen) Then
' Current cost is below the cost of that box in the open list.
' So we update the parent and the cost?
Path.Open.ParentX(isOpen) = x
Path.Open.ParentY(isOpen) = y
Path.Open.PCost(isOpen) = ppp
Path.Open.Cost(isOpen) = cost
End If
End If
End If
End If
End If
Next i

Select Case Path.Open ' The number of cells in the open list...
Case 0
' Nothing left...
GoTo [GetOut]
Case 1
' The only one left? Then of course we'll take it!
selectedBox = 1
Case Else
' Locate the box that has the lowest value in the open list.
' Last box put on the list to reference against:
lastCost = Path.Open.Cost(Path.Open)
selectedBox = Path.Open
' ----------------------------------------------- '
For n = Path.Open To 1 Step -1 ' Look for it going backwards...
referenceCost = Path.Open.Cost(n)
If referenceCost < lastCost Then
lastCost = referenceCost
selectedBox = n ' Location of the box with the smallest cost.
End If
Next n
End Select

' Now let's take the box with the smallest cost and put it in the closed list.

' Becomes the new cell...and the new parent of other cells.
oldX = x : oldY = y
x = Path.Open.X(selectedBox)
y = Path.Open.Y(selectedBox)

ppp = Path.Open.PCost(selectedBox) + 1

Call Path.ClosedPush x,y,Path.Open.ParentX(selectedBox),Path.Open.ParentY(selectedBox) ' Add it to the closed list
Call Path.OpenRemove selectedBox ' Remove it from the open list

Loop Until success

[GetOut]

If success Then
' Figure out the path...
i = Path.IsClosed(x,y)
While i
x = Path.Closed.ParentX(i) : y = Path.Closed.ParentY(i) : c = Path.Open.PCost(i)
If x <> 0 And y <> 0 Then
Con(x,y) = Asc("P") ' Show what's going on for debugging purposes. P = Path
Path.Find = Path.Find + 1
End If
i = Path.IsClosed(x,y)
WEnd
End If
End Function

Sub Path.ClosedPush x,y,parentX,parentY
' Push the square (x,y) onto the closed list.
Path.Closed = Path.Closed + 1
Path.Closed.X(Path.Closed) = x
Path.Closed.Y(Path.Closed) = y
Path.Closed.ParentX(Path.Closed) = parentX
Path.Closed.ParentY(Path.Closed) = parentY
End Sub

Sub Path.OpenPush x,y,parentX,parentY,cost,ppp
' Pushes the square (x,y) with the (parentX,parentY) and (cost)
' onto the open list.
Path.Open = Path.Open + 1
Path.Open.X(Path.Open) = x
Path.Open.Y(Path.Open) = y
Path.Open.Cost(Path.Open) = cost
Path.Open.ParentX(Path.Open) = parentX
Path.Open.ParentY(Path.Open) = parentY
Path.Open.PCost(Path.Open) = ppp
End Sub

Sub Path.OpenRemove index
' Removes the item with the index 'index' from the open list.
If index = 0 Then Exit Sub
For i = index+1 To Path.Open
b = i - 1
Path.Open.X(b) = Path.Open.X(i)
Path.Open.Y(b) = Path.Open.Y(i)
Path.Open.ParentX(b) = Path.Open.ParentX(i)
Path.Open.ParentY(b) = Path.Open.ParentY(i)
Path.Open.Cost(b) = Path.Open.Cost(i)
Path.Open.PCost(b) = Path.Open.PCost(i)
Next i
o = Path.Open
Path.Open.X(o) = 0 : Path.Open.Y(o) = 0 : Path.Open.ParentX(o) = 0
Path.Open.ParentY(o) = 0 : Path.Open.Cost(o) = 0 : Path.Open.PCost(o) = 0
Path.Open = Path.Open - 1
End Sub

Function Path.IsClosed(x,y)
' Returns a number greater than 0 if the box (x,y) is on the closed list.
' This number is the array index of the item on the closed list.
For i = 1 To Path.Closed
If Path.Closed.X(i) = x And Path.Closed.Y(i) = y Then
Path.IsClosed = i
Exit Function
End If
Next i
End Function

Function Path.IsOpen(x,y)
' Returns a number greater than 0 if the box (x,y) is on the open list.
' This number is the array index of the item on the open list.
For i = 1 To Path.Open
If Path.Open.X(i) = x And Path.Open.Y(i) = y Then
Path.IsOpen = i
Exit Function
End If
Next i
End Function

' Takes a string of characters representing a world
' map and loads them into the array for pathfinding.
' It considers the edges as walls.

' " " (space) is considered an empty space
' "+" is considered a wall
' "a" is considered the starting point.
' "b" is considered the ending point.

ReDim Con(width,height)

ReDim Path(width,height)
ReDim Path.Open.X(width*height)
ReDim Path.Open.Y(width*height)
ReDim Path.Open.ParentX(width*height)
ReDim Path.Open.ParentY(width*height)
ReDim Path.Open.Cost(width*height)
ReDim Path.Open.PCost(width*height)
ReDim Path.Closed.X(width*height)
ReDim Path.Closed.Y(width*height)
ReDim Path.Closed.ParentX(width*height)
ReDim Path.Closed.ParentY(width*height)
Path.StartX = 0 : Path.StartY = 0
Path.EndX = 0 : Path.EndY = 0
y = 1
For i = 1 To width * height
x = x + 1
char = Asc(Mid\$(string\$,i,1))
If x = 1 Or x = width Then char = 43  ' Borders ... 43 = wall
If y = 1 Or y = height Then char = 43

If char = 97 Then
' Start location (97 = asc("a"))
' Set the global variables:
Path.StartX = x
Path.StartY = y
End If

If char = 98 Then
' End location (98 = asc("b"))
' Set the global variables:
Path.EndX = x
Path.EndY = y
char = 32 ' Make it a blank space...
End If

Path(x,y) = char
Con(x,y) = char
If x = width Then
' Start the row over:
x = 0
y = y + 1
End If
Next i
' Set the global path width and height:
Path.Width = width : Path.Height = height
End Sub

Sub Path.Print
' Display the loaded world map
Con(Path.StartX,Path.StartY) = asc("S")
Con(Path.EndX,Path.EndY) = asc("E")

For y = 1 To Path.Height
line\$ = ""
For x = 1 To Path.Width
line\$ = line\$;Chr\$(Con(x,y))
Next x
print line\$
Next y
End Sub``````
Last edited by JosephE on Thu Jun 03, 2010 7:55 pm, edited 5 times in total.
stpendl
Posts: 61
Joined: Wed Jan 18, 2006 10:05 pm
Location: Austria
I favor the following display routine, since it indicates the start and end of the path too.

Code: Select all

``````Sub Path.Print
' Display the loaded world map
Con(Path.StartX,Path.StartY) = asc("S")
Con(Path.EndX,Path.EndY) = asc("E")

For y = 1 To Path.Height
line\$ = ""
For x = 1 To Path.Width
line\$ = line\$;Chr\$(Con(x,y))
Next x
print line\$
Next y
End Sub
``````
Stefan
JosephE
Posts: 5
Joined: Wed Mar 26, 2008 2:39 am
Thanks Stefan, I've updated the code to reflect your subroutine and some other additional changes noted above.
stpendl
Posts: 61
Joined: Wed Jan 18, 2006 10:05 pm
Location: Austria
I think, that the path found:

Code: Select all

``````++++++++++++++++++++++++++
+                        +
+ PPPPPPPPP              +
+ P+++++++P              +
+ P+PPPP+ P              +
+ PPP+ P+ P PPP       PPP+
+  + + S+ PPP+PP     PP+P+
+  ++++++++++ +PP   PP+ P+
+          +   +PPPPP+  P+
+ +++++++++     +++++   P+
+          +            P+
+           +++++ PPPPPPP+
+               + P+++++++
+               ++PPPP   +
+               +   +P E +
++++++++++++++++++++++++++
``````
is longer, than it needs to be:

Code: Select all

``````++++++++++++++++++++++++++
+                        +
+ PPPPPPPPP              +
+ P+++++++P              +
+ P+PPPP+ P              +
+ PPP+ P+ PPPPP       PPP+
+  + + S+    +PP     PP+P+
+  ++++++++++ +PP   PP+ P+
+          +   +PPPPP+  P+
+ +++++++++     +++++   P+
+          +            P+
+           +++++ PPPPPPP+
+               + P+++++++
+               ++PPPP   +
+               +   +P E +
++++++++++++++++++++++++++
``````
Stefan
stpendl
Posts: 61
Joined: Wed Jan 18, 2006 10:05 pm
Location: Austria
I would replace CHR\$(0) by a space in the display routine.

Code: Select all

``````Sub Path.Print
' Display the loaded world map
Con(Path.StartX,Path.StartY) = asc("S")
Con(Path.EndX,Path.EndY) = asc("E")

For y = 1 To Path.Height
line\$ = ""
For x = 1 To Path.Width
if Con(x,y) = 0 then
line\$ = line\$;" "
else
line\$ = line\$;Chr\$(Con(x,y))
end if
Next x
print line\$
Next y
End Sub
``````
This way one can copy and paste from the window, without the need to use save from the menu and replace {NUL} by {Space}.
Stefan
cassiope01
Posts: 56
Joined: Sat Jun 06, 2009 7:27 am
Location: FRANCE, Montpellier

Code: Select all

``````
++++++++++++++++++++++++++
+                        +
+ PPPPPPPPP              +
+ P+++++++P              +
+ P+PPPP+ P              +
+ PPP+ P+ PPPPP       PPP+
+  + + S+    +PP     PP+P+
+  ++++++++++ +PP   PP+ P+
+          +   +PPPPP+  P+
+ +++++++++     +++++   P+
+          +            P+
+           +++++ PPPPPPP+
+               + P+++++++
+               ++PPPP   +
+               +   +P E +
++++++++++++++++++++++++++
``````
must be

Code: Select all

``````++++++++++++++++++++++++++
+                        +
+ PPPPPPPPP              +
+ P+++++++P              +
+ P+PPPP+ P              +
+ PPP+ P+ PPPPPPPPPPPPPPP+
+  + + S+    +         +P+
+  ++++++++++ +       + P+
+          +   +     +  P+
+ +++++++++     +++++   P+
+          +            P+
+           +++++ PPPPPPP+
+               + P+++++++
+               ++PPPP   +
+               +   +PPE +
++++++++++++++++++++++++++
``````
JosephE
Posts: 5
Joined: Wed Mar 26, 2008 2:39 am
Thanks guys! It's been updated several times today.