Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
My own try at A*
#1
I fell bad about taking someone elses idea, but it seemed fun. Anyway, I've attempted and failed. Well... I haven't gotten past the FB compilation errors. Could anyone tell me how to fix the error? Here is the code:

[syntax="qbasic"]
DefInt A-Z
'$Dynamic

Declare Sub ClearScreen()
Declare Sub FindPath()
Declare Sub DrawScreen()


const Ground = 0
const Water = 1
const Hill = 2
const Start = 3
const Finish = 4
const False = 0
const True = Not False

const HillCost = 20
const GroundCost = 10

Type pSquareType
x As Integer
y As Integer
End Type

Type SquareType
pSquare As pSquareType
fScore As Integer
gScore As Integer
hScore As Integer
mType As Integer
onOpen As Integer
onClosed As Integer
End Type

Type AIType
x As Integer
y As Integer
End Type

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

Dim Shared Board(sWidth, sHeight) As SquareType
Dim Shared Path() As pSquareType
Dim Shared mStart As pSquareType
Dim Shared mFinish As pSquareType
Dim comp As AIType

For i = 1 To uBound(Board, 2)
For j = 1 to uBound(Board, 1)
Input #1, Board(i,j).mType
If Board(i,j).mType = Start Then
mStart.x = i
mStart.y = j
Else If Board(i,j).mType = Finish Then
mFinish.x = i
mFinish.y = j
End If
Next j
Next i

CLS

Board(mStart.x, mStart.y).onOpen = True
FindPath

i = 1
'Main Loop
Do
ClearScreen

comp.x = Path(i).x
comp.y = Path(i).y

DrawScreen

i = i + 1

Do While Inkey$ = ""
Loop

Loop

Sub FindPath()
'Using The A* Algorithm, find the shortest path to the End Point
Dim gScore

Dim c As pSquareType
c.x = mStart.x
c.y = mStart.y
For x = 1 to 3
For y = 1 to 3
Board((c.x + x),(c.y + y)).pSquare.x = mStart.x
Board((c.x + x),(c.y + y)).pSquare.y = mStart.y
Next y
Next x

Do While onFinish = False
Board(c.x,c.y).onClosed = True
For x = 1 to 3
For y = to 3

If Not Board((c.x + x),(c.y + y)).onClosed = True Then 'If it's not on the closed list
If Not Board((c.x + x),(c.y + y)).mType = Water Then 'If it's not a water tile
If Board((c.x + x),(c.y + y)).onOpen = False Then 'If it's not on the open list

Board((c.x + x),(c.y + y)).onOpen = True
If Board((c.x + x),(c.y + y)).mType = Hill Then
Board((c.x + x),(c.y + y)).gScore = HillCost
Else
Board((c.x + x),(c.y + y)).gScore = GroundCost
End If

hx = ABS(mFinish.x - (c.x + x))
hy = ABS(mFinish.y - (c.y + y))

Board((c.x + x),(c.y + y)).hScore = hx + hy
Board((c.x + x),(c.y + y)).fScore = Board((c.x + x),(c.y + y)).gScore + Board((c.x + x),(c.y + y)).hScore

Board((c.x + x),(c.y + y)).pSquare.x = c.x
Board((c.x + x),(c.y + y)).pSquare.y = c.y
If c.x + x = mFinish.x And c.y + y = mFinish.y Then 'We've made it to the finish!
onFinish = True
End If
Else 'Then it is on the open list

If Board((c.x + x),(c.y + y)).mType = Hill Then
tempG = HillCost
Else
tempG = GroundCost
End If

If Board((c.x + x),(c.y + y)).gScore > (Board(c.x,c.y).gScore + tempG) Then
Board((c.x + x),(c.y + y)).pSquare.x = c.x
Board((c.x + x),(c.y + y)).pSquare.y = c.y
End If

End If
End If
End If
Next y
Next x
curScore = 20000
For y = 1 to uBound(Board, 2)
For x = 1 to uBound(Board, 1)
If Board(x,y).onOpen = True Then
If Board(x,y).fScore < curScore Then
c.x = x
c.y = y
curScore = Board(x,y).fScore
End If
End If
Next x
Next y

Loop
'We've found the finish square. Time to walk backwards to get our path

Dim tempPath(sWidth*sHeight) As pSquareType
Dim t As pSquareType
t.x = mFinish.x
t.y = mFinish.y
i = 1
tempPath(i).x = t.x
tempPath(i).y = t.y

Do While EndOfPath = False
i = i + 1
tempPath(i).x = Board(t.x,t.y).pSquare.x
tempPath(i).y = Board(t.x,t.y).pSquare.y
t.x = Board(tempPath(i).x, tempPath(i).y).pSquare.x
t.y = Board(tempPath(i).x, tempPath(i).y).pSquare.y

If t.x = mStart.x And t.y = mStart.y Then
EndOfPath = True
End If

Loop
EndOfPath = False
j = 1
Do While i <> False
Path(j).x = tempPath(i).x
Path(j).y = tempPath(i).y
i = i - 1
j = j + 1
Loop

End Sub

Sub ClearScreen()
Line (0,0)-(640,480),0,BF
End Sub

Sub DrawScreen
For y = 1 to uBound(Board,2)
For x = 1 to uBound(Board,1)
If Board(x,y).mType = Ground Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 2, BF
Else If Board(x,y).mType = Hill Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 21, BF
Else If Board(x,y).mType = Water Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 33, BF
Else If Board(x,y).mType = Start Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 15, BF
Else If Board(x,y).mType = Finish Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 4, BF
End If

Circle ((comp.x * 10 + 5), (comp.y * 10 + 5)), 3, 14

Locate 1,1
Print "Press Any Key to Continue"

Next x
Next y
End Sub
[/syntax]

On line 59, I'm getting the following error:

Code:
Illegal outside a compound statement, found: 'Next'
Next j
^

No clue what this is. Any idea?[/code]
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Reply
#2
You forget that in QB and FB, the "else if" should be "elseif" (no space). That should help a lot.

Alternatively, you could have them split up:

Code:
else
  if . . .
  else
    if . . .
    else
      if . . .
      end if
    end if
  end if
end if

(though it is pretty pointless and a waste of space)
974277320612072617420666C61696C21 (Hexadecimal for those who don't know)
Reply
#3
Woops! :oops: How silly of me.

Well... Here is the new code:

[syntax="qbasic"]DefInt A-Z
'$Dynamic

Declare Sub ClearScreen()
Declare Sub FindPath()
Declare Sub DrawScreen()


const Ground = 0
const Water = 1
const Hill = 2
const Start = 3
const Finish = 4
const False = 0
const True = Not False

const HillCost = 20
const GroundCost = 10

Type pSquareType
x As Integer
y As Integer
End Type

Type SquareType
pSquare As pSquareType
fScore As Integer
gScore As Integer
hScore As Integer
mType As Integer
onOpen As Integer
onClosed As Integer
End Type

Type AIType
x As Integer
y As Integer
End Type

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

Dim Shared Board(sWidth, sHeight) As SquareType
Dim Shared Path() As pSquareType
Dim Shared mStart As pSquareType
Dim Shared mFinish As pSquareType
Dim comp As AIType

For i = 1 To uBound(Board, 2)
For j = 1 to uBound(Board, 1)
Input #1, Board(i,j).mType
If Board(i,j).mType = Start Then
mStart.x = i
mStart.y = j
ElseIf Board(i,j).mType = Finish Then
mFinish.x = i
mFinish.y = j
End If
Next j
Next i

Screen 18
CLS

Board(mStart.x, mStart.y).onOpen = True
FindPath

i = 1
'Main Loop
Do
ClearScreen

comp.x = Path(i).x
comp.y = Path(i).y

DrawScreen

i = i + 1

Do While Inkey$ = ""
Loop

Loop

Sub FindPath()
'Using The A* Algorithm, find the shortest path to the End Point
Dim gScore

Dim c As pSquareType
c.x = mStart.x
c.y = mStart.y
For x = 1 to 3
For y = 1 to 3
Board((c.x + x),(c.y + y)).pSquare.x = mStart.x
Board((c.x + x),(c.y + y)).pSquare.y = mStart.y
Next y
Next x

Do While onFinish = False
Board(c.x,c.y).onClosed = True
For x = 1 to 3
For y = 1 to 3

If Not Board((c.x + x),(c.y + y)).onClosed = True Then 'If it's not on the closed list
If Not Board((c.x + x),(c.y + y)).mType = Water Then 'If it's not a water tile
If Board((c.x + x),(c.y + y)).onOpen = False Then 'If it's not on the open list

Board((c.x + x),(c.y + y)).onOpen = True
If Board((c.x + x),(c.y + y)).mType = Hill Then
Board((c.x + x),(c.y + y)).gScore = HillCost
Else
Board((c.x + x),(c.y + y)).gScore = GroundCost
End If

hx = ABS(mFinish.x - (c.x + x))
hy = ABS(mFinish.y - (c.y + y))

Board((c.x + x),(c.y + y)).hScore = hx + hy
Board((c.x + x),(c.y + y)).fScore = Board((c.x + x),(c.y + y)).gScore + Board((c.x + x),(c.y + y)).hScore

Board((c.x + x),(c.y + y)).pSquare.x = c.x
Board((c.x + x),(c.y + y)).pSquare.y = c.y
If c.x + x = mFinish.x And c.y + y = mFinish.y Then 'We've made it to the finish!
onFinish = True
End If
Else 'Then it is on the open list

If Board((c.x + x),(c.y + y)).mType = Hill Then
tempG = HillCost
Else
tempG = GroundCost
End If

If Board((c.x + x),(c.y + y)).gScore > (Board(c.x,c.y).gScore + tempG) Then
Board((c.x + x),(c.y + y)).pSquare.x = c.x
Board((c.x + x),(c.y + y)).pSquare.y = c.y
End If

End If
End If
End If
Next y
Next x
curScore = 20000
For y = 1 to uBound(Board, 2)
For x = 1 to uBound(Board, 1)
If Board(x,y).onOpen = True Then
If Board(x,y).fScore < curScore Then
c.x = x
c.y = y
curScore = Board(x,y).fScore
End If
End If
Next x
Next y

Loop
'We've found the finish square. Time to walk backwards to get our path

Dim tempPath(sWidth*sHeight) As pSquareType
Dim t As pSquareType
t.x = mFinish.x
t.y = mFinish.y
i = 1
tempPath(i).x = t.x
tempPath(i).y = t.y

Do While EndOfPath = False
i = i + 1
tempPath(i).x = Board(t.x,t.y).pSquare.x
tempPath(i).y = Board(t.x,t.y).pSquare.y
t.x = Board(tempPath(i).x, tempPath(i).y).pSquare.x
t.y = Board(tempPath(i).x, tempPath(i).y).pSquare.y

If t.x = mStart.x And t.y = mStart.y Then
EndOfPath = True
End If

Loop
EndOfPath = False
j = 1
Do While i <> False
Path(j).x = tempPath(i).x
Path(j).y = tempPath(i).y
i = i - 1
j = j + 1
Loop

End Sub

Sub ClearScreen()
Line (0,0)-(640,480),0,BF
End Sub

Sub DrawScreen
For y = 1 to uBound(Board,2)
For x = 1 to uBound(Board,1)
If Board(x,y).mType = Ground Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 2, BF
ElseIf Board(x,y).mType = Hill Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 21, BF
ElseIf Board(x,y).mType = Water Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 33, BF
ElseIf Board(x,y).mType = Start Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 15, BF
ElseIf Board(x,y).mType = Finish Then
Line (x * 10, y * 10) - ((x * 10 + 10), (y * 10 + 10)), 4, BF
End If

Circle ((comp.x * 10 + 5), (comp.y * 10 + 5)), 3, 14

Locate 1,1
Print "Press Any Key to Continue"

Next x
Next y
End Sub
[/syntax]

I'm still stuck. Anybody have any idea why it doesn't do anything?
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Reply
#4
Oh, and I almost forgot, you'll need to make your own "board.brd" file for this to work. Here is my board.

Code:
20,15
0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,3,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,2,2,2,2,2,2,1,1,2,2,2,0,0,0,0,0
0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0,0
0,0,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,0,0,0
0,0,0,0,2,2,2,2,2,1,1,2,2,2,0,0,0,0,0,0
0,0,0,0,0,0,2,2,2,2,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,2,2,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,4,0,0
0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0,0
0,0,0,0,0,0,0,0,0,0,0,1,1,0,0,0,0,0,0,0

Oh... For crying out loud! I forgot to put a Finish square on there. Sheesh... Ok, fixed it. Time to test it out.

Darn, still doesn't work. Please see what you can do.
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Reply
#5
Nobody knows? Cry
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Reply
#6
Well... Just for a test, I put a "PRINT "."; statement into the Findpath sub. And whadda ya know. It's working. It just can't seem to find the route. Hmm...
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Reply
#7
I think I could implement A* in FB without too much problem. The only thing is I'm in the middle of my exams and don't really have time to read about A* and implement it. (Yes I have to read it first too, just like how I implemented MD5 in FreeBasic as the first one to do it Big Grin).
Reply
#8
Well, I'm gonna redo the entire thing, since I seem to have done a poor job on this one. I apparently did my A* routine poorly, which is why it can't find a good path. I'll post back when complete (Although I'm glad It is at least looking through the squares... I think)
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Reply
#9
Even though it doesn't work, the code looks very readable and structured...
It's the difference between asking someone how much flour goes into pancakes, and handing them a sorry mix of oozing green goo and asking them to fix it." - Deleter

-Founder & President of the No More Religion Threads movement-
Reply
#10
I made one for http://forum.qbasicnews.com/viewtopic.php?t=5801 . Which was ever so long ago. Direct link to my entry
http://mywebpages.comcast.net/whitetiger.../ASTAR.TXT


It looks unstructured (I should have used tabs =P)
I have no clue what I was thinking with the variable names.


It's pretty bad but it works last time I checked.
[Image: sig.php]
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Reply


Forum Jump:


Users browsing this thread: 1 Guest(s)