A* Pathfinding Library

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

A* Pathfinding Library

Post by JosephE »

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

Call Path.Load world$, worldWidth, worldHeight
start = Time$("ms")
test = Path.Find(s$)
print "time: "; (time$("ms") - start)
Print "result: ";test
Call Path.Print
Print "answer: ";s$
End

Function Path.Find(BYREF answer$)
    ' Returns 0 (false) if a path was not found.

    ' Otherwise the answer is the number of coordinates in answer$
    ' 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:
    ' cord1$ = Word$(answer$,1)
    ' 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
                answer$ = Trim$(x;"_";y;" ";answer$)
                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

Sub Path.Load string$, width, height
    ' 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
Site Admin
Posts: 61
Joined: Wed Jan 18, 2006 10:05 pm
Location: Austria

Post by stpendl »

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
The invisible Admin
JosephE
Posts: 5
Joined: Wed Mar 26, 2008 2:39 am

Post by JosephE »

Thanks Stefan, I've updated the code to reflect your subroutine and some other additional changes noted above.
stpendl
Site Admin
Posts: 61
Joined: Wed Jan 18, 2006 10:05 pm
Location: Austria

Post by stpendl »

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
The invisible Admin
stpendl
Site Admin
Posts: 61
Joined: Wed Jan 18, 2006 10:05 pm
Location: Austria

Post by stpendl »

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
The invisible Admin
cassiope01
Posts: 56
Joined: Sat Jun 06, 2009 7:27 am
Location: FRANCE, Montpellier

Post by cassiope01 »

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

Post by JosephE »

Thanks guys! It's been updated several times today.