My own try at A*

[dumbledore]

mua ha ha ha.... yours is really complicated. here's my modified a* algo, from the description i read the normal a* shouldn't be able to find its way through what i gave it without modification like i did...

Code:

declare function timesvisited( byval x as integer, byval y as integer ) as byte
declare function outofbounds( byval x as integer, byval y as integer ) as byte

cls
type coord
    x as ubyte
    y as ubyte
end type
redim preserve shared badnodes( 0 ) as coord
dim as integer working( 7 )
dim as integer x, y, cx, cy, ex, ey, i
dim shared as integer mx, my
read mx
read my
dim as ubyte room( mx * my )
for y = 0 to my - 1
    for x = 0 to mx - 1
        read room( x + y * mx )
        select case room( x + y * mx )
        case 1
            ? "|";
        case 2
            ? "@";
            cx = x
            cy = y
        case 3
            ? "*";
            ex = x
            ey = y
        case else
            ? " ";
        end select
    next
    ?
next

while cx <> ex or cy <> ey
    
    dim as integer max = 100
    
    working( 0 ) = 10 + sqr( ( cx - ex ) ^ 2 + ( cy - 1 - ey ) ^ 2 ) * 10 + timesvisited( cx, cy - 1 )
    if room( cx + ( cy - 1 ) * mx ) = 1 or outofbounds( cx, cy - 1 ) then working( 0 ) = -1
    max = working( 0 )
    
    working( 1 ) = 14 + sqr( ( cx + 1 - ex ) ^ 2 + ( cy - 1 - ey ) ^ 2 ) * 10 + timesvisited( cx + 1, cy - 1 )
    if room( cx + 1 + ( cy - 1 ) * mx ) = 1 or room( cx + ( cy - 1 ) * mx ) = 1 or room( cx + 1 + cy * mx ) = 1 or outofbounds( cx + 1, cy - 1 ) then working( 1 ) = -1
    if working( 1 ) > max then max = working( 1 )
    
    working( 2 ) = 10 + sqr( ( cx + 1 - ex ) ^ 2 + ( cy - ey ) ^ 2 ) * 10 + timesvisited( cx + 1, cy )
    if room( cx + 1 + cy * mx ) = 1 or outofbounds( cx + 1, cy ) then working( 2 ) = -1
    if working( 2 ) > max then max = working( 2 )
    
    working( 3 ) = 14 + sqr( ( cx + 1 - ex ) ^ 2 + ( cy + 1 - ey ) ^ 2 ) * 10 + timesvisited( cx + 1, cy + 1 )
    if room( cx + 1 + ( cy + 1 ) * mx ) = 1 or room( cx + ( cy + 1 ) * mx ) = 1 or room( cx + 1 + cy * mx ) = 1 or outofbounds( cx + 1, cy + 1 ) then working( 3 ) = -1
    if working( 3 ) > max then max = working( 3 )
    
    working( 4 ) = 10 + sqr( ( cx - ex ) ^ 2 + ( cy + 1 - ey ) ^ 2 ) * 10 + timesvisited( cx, cy + 1 )
    if room( cx + ( cy + 1 ) * mx ) = 1 or outofbounds( cx, cy + 1 ) then working( 4 ) = -1
    if working( 4 ) > max then max = working( 4 )
    
    working( 5 ) = 14 + sqr( ( cx - 1 - ex ) ^ 2 + ( cy + 1 - ey ) ^ 2 ) * 10 + timesvisited( cx - 1, cy + 1 )
    if room( cx - 1 + ( cy + 1 ) * mx ) = 1 or room( cx + ( cy + 1 ) * mx ) = 1 or room( cx - 1 + cy * mx ) = 1 or outofbounds( cx - 1, cy + 1 ) then working( 5 ) = -1
    if working( 5 ) > max then max = working( 5 )
    
    working( 6 ) = 10 + sqr( ( cx - 1 - ex ) ^ 2 + ( cy - ey ) ^ 2 ) * 10 + timesvisited( cx - 1, cy )
    if room( cx - 1 + cy * mx ) = 1 or outofbounds( cx - 1, cy ) then working( 6 ) = -1
    if working( 6 ) > max then max = working( 6 )
    
    working( 7 ) = 14 + sqr( ( cx - 1 - ex ) ^ 2 + ( cy - 1 - ey ) ^ 2 ) * 10 + timesvisited( cx - 1, cy - 1 )
    if room( cx - 1 + ( cy - 1 ) * mx ) = 1 or room( cx + ( cy - 1 ) * mx ) = 1 or room( cx - 1 + cy * mx ) = 1 or outofbounds( cx - 1, cy - 1 ) then working( 7 ) = -1
    if working( 7 ) > max then max = working( 7 )
    
    dim as integer lowest, lowestidx = 0
    lowest = max + 1
    for i = 0 to 7
        if working( i ) < lowest and working( i ) <> -1 then lowest = working( i ) : lowestidx = i
    next
    
    locate cy + 1, cx + 1: ? " "
    
    if lowest <> max + 1 then
        select case lowestidx
        case 0
            cy -= 1
        case 1
            cx += 1
            cy -= 1
        case 2
            cx += 1
        case 3
            cx += 1
            cy += 1
        case 4
            cy += 1
        case 5
            cx -= 1
            cy += 1
        case 6
            cx -= 1
        case 7
            cx -= 1
            cy -= 1
        case else
            ? "error":sleep:end
        end select
    end if
    
    locate cy + 1, cx + 1: ? "!"
    
    badnodes( ubound( badnodes ) ).x = cx
    badnodes( ubound( badnodes ) ).y = cy
    redim preserve shared badnodes( ubound( badnodes ) + 1 )
    
    if cx = ex and cy = ey then locate 9,9: ? "done!"
    
    sleep
    
wend

data 8,5
data 0,0,0,0,0,0,0,1
data 0,0,0,1,1,1,1,1
data 0,2,0,1,1,0,3,0
data 0,0,0,1,1,0,0,0
data 0,0,0,0,0,0,0,0

function timesvisited( byval x as integer, byval y as integer ) as byte
    
    dim as integer i, num = 0
    for i = 0 to ubound( badnodes ) - 1
        if badnodes( i ).x = x and badnodes( i ).y = y then num += 1
    next
    return num * 10
    
end function

function outofbounds( byval x as integer, byval y as integer ) as byte
    
    return x < 0 or x > mx - 1 or y < 0 or y > my - 1
    
end function

[edit] fixed a couple of dimensioning problems, should be good with any map now.

[rpgfan3233]

Good job. I'm still struggling a bit. I'm making progress, just a LOT more slowly than everybody else. School filled my head with useless words when they should've filled it with numbers.

[Torahteen]

Well, good job. But what makes yours any simpler :-? ? It's nearly impossible to read.

[Edit] And actually, it couldn't be considered A* anyway. Where is you F, G, and H scores? You can't have the computer move according to the type of terrain, which is one of A*'s cabablities. [/Edit]

[Torahteen]

Woot! My A* algo works! I just forgot to put a wall around the board. It works! Woohoo!

[Torahteen]

Final code!

[syntax="qbasic"]DefInt A-Z
'$Dynamic
Declare Sub ClearScreen()
Declare Sub DrawScreen()

Declare Sub FindPath()
Declare Sub AddToOpen(x As Integer, y As Integer)
Declare Sub AddToClosed(x As Integer, y As Integer)
Declare Sub AddToPath(x As Integer, y As Integer)
Declare Function IsOnOpen(x As Integer, y As Integer)
Declare Function IsOnClosed(x As Integer, y As Integer)

const Ground = 0
const Hill = 2
const Water = 1
const Wall = 4
const Start = 6
const Finish = 5

const False = 0
const True = Not False

const GroundCost = 10
const HillCost = 25
const WaterCost = 50

Type SquareType
fScore As Integer
gScore As Integer
hScore As Integer
mType As Integer
pX As Integer
pY As Integer
End Type

Type PointType
x As Integer
y As Integer
End Type
cls
Screen 18

Open "board.brd" For Input As #1
Input #1, sWidth, sHeight

Dim Shared Map(sWidth, sHeight) As SquareType
Dim Shared OpenList() As PointType
Dim Shared ClosedList() As PointType
Dim Shared Path() As PointType
Dim Shared mStart As PointType
Dim Shared mFinish As PointType
Dim Shared comp As PointType

For y = 1 To sHeight
For x = 1 To sWidth
Input #1, Map(x,y).mType
If Map(x,y).mType = Finish Then
mFinish.x = x
mFinish.y = y
ElseIf Map(x,y).mType = Start Then
mStart.x = x
mStart.y = y
End If
Next x
Next y
Close #1
Print "Finding Path"

FindPath

Print "Path Found"
sleep

ClearScreen
DrawScreen

Sleep
End

Sub FindPath()
'A* pathfinding Algorithm
Dim c As PointType 'Current Square
Dim onFinish As Integer

c.x = mStart.x 'Set the current square to
c.y = mStart.y 'the start square coord.

Do While onFinish = False 'Do this while we have not found the Finish square

AddToClosed c.x, c.y 'Add the current square to the Closed list
For y = -1 to 1
For x = -1 to 1
If Not Map((c.x + x),(c.y+y)).mType = Wall Then 'If it is not a Wall square
If (IsOnClosed((c.x + x),(c.y + y))) = False Then 'If it is not on the Closed List
If (IsOnOpen((c.x + x),(c.y + y))) = False Then 'It is not on the Open list, add it

'Calculate F, G, and H scores
'G First
If Map((c.x + x),(c.y + y)).mType = Ground Then
Map((c.x + x),(c.y + y)).gScore = Map((c.x),(c.y)).gScore + GroundCost
ElseIF Map((c.x + x),(c.y + y)).mType = Hill Then
Map((c.x + x),(c.y + y)).gScore = Map((c.x),(c.y)).gScore + HillCost
ElseIf Map((c.x + x),(c.y + y)).mType = Water Then
Map((c.x + x),(c.y + y)).gScore = Map((c.x),(c.y)).gScore + WaterCost
End If

'Now H score using Manhattan distance
hx = 10 * (ABS(((c.x + x)-(mFinish.x))))
hy = 10 * (ABS(((c.y + y)-(mFinish.y))))

Map((c.x + x),(c.y + y)).hScore = hx + hy

'Finally, the F score

Map((c.x + x),(c.y + y)).fScore = Map((c.x + x),(c.y + y)).gScore + Map((c.x + x),(c.y + y)).hScore

'Make the current square the parent of this square
Map((c.x + x),(c.y + y)).pX = c.x
Map((c.x + x),(c.y + y)).pY = c.y

'Then add this square to the Open List

AddToOpen (c.x + x), (c.y + y)

'If it's the finish square, we've found the path!
If (c.x + x) = mFinish.x And (c.y + y) = mFinish.y Then
onFinish = True
End If

Else 'Then it is on the Open List. Check to see if this is the better route

If Map((c.x + x),(c.y + y)).mType = Ground Then
tempG = Map((c.x),(c.y)).gScore + GroundCost
ElseIF Map((c.x + x),(c.y + y)).mType = Hill Then
tempG = Map((c.x),(c.y)).gScore + HillCost
ElseIf Map((c.x + x),(c.y + y)).mType = Water Then
tempG = Map((c.x),(c.y)).gScore + WaterCost
End If

If tempG < Map((c.x + x),(c.y + y)).gScore Then 'This is the better route
'Make the current square the parent of this square
Map((c.x + x),(c.y + y)).pX = c.x
Map((c.x + x),(c.y + y)).pY = c.y

'Recalculate G and F scores
'G
Map((c.x + x),(c.y + y)).gScore = tempG
'F
Map((c.x + x),(c.y + y)).fScore = Map((c.x + x),(c.y + y)).gScore + Map((c.x + x),(c.y + y)).hScore

End If

End If
End If
End If
Next x
Next y

'Go through the Open List to find the lowest F score
curScore = 20000
For i = 1 to uBound(OpenList)
If IsOnClosed((OpenList(i).x),(OpenList(i).y)) = False Then
If Map((OpenList(i).x),(OpenList(i).y)).fScore <= curScore Then
c.x = OpenList(i).x
c.y = OpenList(i).y
curScore = Map((OpenList(i).x),(OpenList(i).y)).fScore
End If
End If
Next i

Loop

'We've found the target square.
Dim onStart As Integer
c.x = mFinish.x
c.y = mFinish.y
i = 1
Do While onStart = False
AddToPath c.x,c.y

If c.x = mStart.x And c.y = mStart.y Then
onStart = True
End If

x = c.x
y = c.y

c.x = Map(x,y).pX 'Make the Current Square the parent square
c.y = Map(x,y).pY

i = i + 1 'Increment i
Loop

End Sub

Sub AddToOpen(x As Integer, y As Integer)
Dim TempOpen(uBound(OpenList)) As PointType

For i = 1 to uBound(OpenList)
TempOpen(i).x = OpenList(i).x
TempOpen(i).y = OpenList(i).y
Next i
size = uBound(OpenList)
Redim OpenList(size+1) As PointType

For i = 1 to uBound(TempOpen)
OpenList(i).x = TempOpen(i).x
OpenList(i).y = TempOpen(i).y
Next i

OpenList(uBound(OpenList)).x = x
OpenList(uBound(OpenList)).y = y
End Sub

Sub AddToClosed(x As Integer, y As Integer)
Dim TempClosed(uBound(ClosedList)) As PointType

For i = 1 to uBound(ClosedList)
TempClosed(i).x = ClosedList(i).x
TempClosed(i).y = ClosedList(i).y
Next i
size = uBound(ClosedList)
Redim ClosedList(size+1) As PointType

For i = 1 to uBound(TempClosed)
ClosedList(i).x = TempClosed(i).x
ClosedList(i).y = TempClosed(i).y
Next i

ClosedList(uBound(ClosedList)).x = x
ClosedList(uBound(ClosedList)).y = y
End Sub

Sub AddToPath(x As Integer, y As Integer)
Dim TempPath(uBound(Path)) As PointType

For i = 1 to uBound(Path)
TempPath(i).x = Path(i).x
TempPath(i).y = Path(i).y
Next i
size = uBound(Path)
Redim Path(size+1) As PointType

For i = 1 to uBound(TempPath)
Path(i).x = TempPath(i).x
Path(i).y = TempPath(i).y
Next i

Path(uBound(Path)).x = x
Path(uBound(Path)).y = y
End Sub

Function IsOnOpen(x As Integer, y As Integer)
For i = 1 to uBound(OpenList)
If OpenList(i).x = x And OpenList(i).y = y Then
'It's on the open list
IsOnOpen = True
Exit For
End If
Next i
End Function

Function IsOnClosed(x As Integer, y As Integer)
For i = 1 to uBound(ClosedList)
If ClosedList(i).x = x And ClosedList(i).y = y Then
'It's on the closed list
IsOnClosed = True
Exit For
End If
Next i
End Function

Sub ClearScreen()
Line (0,0)-(319,199), 0, BF
End Sub

Sub DrawScreen()
For y = 1 to uBound(Map, 2)
For x = 1 to uBound(Map,1)
Square = Map(x,y).mType
Select Case Square
Case Ground: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 2, BF
Case Hill: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 21, BF
Case Water: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 33, BF
Case Wall: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 8, BF
Case Start: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 15, BF
Case Finish: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 4, BF
End Select
Next x
Next y
Dim ox, oy As Integer
ox = mFinish.x
oy = mFinish.y

For i = 1 To uBound(Path)
x = Path(i).x
y = Path(i).y
Line (ox * 10 + 5,oy * 10 + 5)-(x * 10 + 5,y * 10 + 5), 14
ox = x
oy = y
Next i

Locate 20,1
For i = 1 To uBound(Path)
Print Path(i).x;
Print ",";
Print Path(i).y;
Next i
End Sub
[/syntax]

Try it out. Here is a sample board:

Code:

12,10
4,4,4,4,4,4,4,4,4,4,4,4
4,0,0,0,0,2,2,2,2,2,2,4
4,0,0,0,0,2,2,2,2,2,6,4
4,0,0,0,0,4,4,2,2,2,2,4
4,0,0,0,0,4,4,0,2,2,2,4
4,0,5,0,0,4,4,0,0,0,2,4
4,0,0,0,0,4,4,0,0,0,0,4
4,0,0,0,0,1,1,0,0,0,0,4
4,0,0,0,0,1,1,1,0,0,0,4
4,4,4,4,4,4,4,4,4,4,4,4

Oh, here's another. Also, make your own, tell me how it works (if it does). Remember to put a wall around the boards! Thanks for all your help.

[dumbledore]

sure it is.

Code:

working( 0 ) = 10 + sqr( ( cx - ex ) ^ 2 + ( cy - 1 - ey ) ^ 2 ) * 10 + timesvisited( cx, cy - 1 )

the working( 0 ) is the f variable, the 10 is the g variable, and the sqr( ( cx - ex ) ^ 2 + ( cy - 1 - ey ) ^ 2 ) * 10 is the h variable. i used a standard distance formula instead of the "manhattan method" because it's faster. the last part is a weighted - probability thing i added to it so it wouldn't get stuck in holes.

[dumbledore]

hm, you do have a point there, i didn't use opened / closed squares, mainly because i don't think i get something....
if you have a map like this:

Code:

0,0,0,0,0
0,1,1,1,0
0,2,0,1,3
0,1,1,1,0
0,0,0,0,0

what's to keep it from going right? :/

[Torahteen]

:-? Oh, ok. Sorry. Next time I'll (try to) read the code before I say anything :roll: . You have your program use the current F score to move your... eh... Comp? Anyway, this means it will move into the wrong direction, then go back the right direction. Not that that is a big deal, I just think you should do what I did and store the correct path into an array.

Truthfully, I think that your code is harder to read than mine. Course, that may be because I didn't type it, but that's just me. I guess I just use a more "OOP" approach?

[rpgfan3233]

Truthfully, I think that your code is harder to read than mine. Course, that may be because I didn't type it, but that's just me. I guess I just use a more "OOP" approach?

Yeah, yours is definitely more object-oriented. :roll:
IMO, dumbledore's is hard to read because of the line length. That can't really be helped because of the way it was created.

[Torahteen]

By OOP, I meant that My program is more "Split up". I have different Subs to do Different Things. Sorry if that sounded stupid :roll: .