Posts: 500
Threads: 7
Joined: Jun 2005
@Torahteen: Is the "board.brd" file saved in the same directory as the compiled program? If it is, I can send you that file.
@dumbledore: Yeah, but it doesn't take much time either way, so I probably won't do it.
974277320612072617420666C61696C21 (Hexadecimal for those who don't know)
Posts: 684
Threads: 64
Joined: May 2004
Yep sure is. Let me try again tonight to check.
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Posts: 684
Threads: 64
Joined: May 2004
Well, it worked this time. Wierd. Anyway. I add the cliff idea to my code. Ty. I like the way you made your program show the path. Our programs show completly different paths. Probably because mine doesn't do diagonal costs. Although, mine seems to find a shorter path. Try running mine with this 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 Cliff = 3
const Wall = 4
const Start = 5
const Finish = 6
const False = 0
const True = Not False
const GroundCost = 10
const HillCost = 25
const WaterCost = 50
const CliffCost = 100
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
For i = 1 to uBound(Path)
comp.x = (Path(i).x * 10 + 5)
comp.y = (Path(i).y * 10 + 5)
ClearScreen
DrawScreen
Sleep
Next i
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
Print ".";
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
ElseIF Map((c.x + x),(c.y + y)).mType = Cliff Then
Map((c.x + x),(c.y + y)).gScore = Map((c.x),(c.y)).gScore + CliffCost
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
ElseIf Map((c.x + x),(c.y + y)).mType = Cliff Then
tempG = Map((c.x),(c.y)).gScore + CliffCost
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)-(639,479), 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 Cliff: Line(x * 10, y * 10)-(x * 10 + 10, y * 10 + 10), 7, 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
Circle (comp.x, comp.y), 3, 14
Locate 20,1
For i = 1 To uBound(Path)
Print Path(i).x;
Print ",";
Print Path(i).y;
Next i
End Sub[/syntax]
... and use your map and see the difference.
Edit: Also try to reverse the start and finsh positions, since mine walks backwards through the path. It seems to find a different path that way.
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Posts: 500
Threads: 7
Joined: Jun 2005
Yeah, yours finds a shorter path. That is due mainly to 2 factors:
- Mine checks for walls adjacent to the current square (dumbledore's idea), whereas yours doesn't.
- Mine uses a different formula for calculating the hScore (dumbledore's idea). (this seems to be the biggest reason)
[/list:o]
If you implement both of those (they aren't very hard), you'll find that the fScores are the same and the same paths are taken.
Edit: I forgot to add that your Hill and Water constants are switched compared to mine. I'll change mine to match yours.
974277320612072617420666C61696C21 (Hexadecimal for those who don't know)
Posts: 684
Threads: 64
Joined: May 2004
I understand. Well, I think I've completed my code. I'll make more when I need to.
quote="Deleter"]judging gameplay, you can adaquately compare quake 4 with pong[/quote]
Posts: 489
Threads: 34
Joined: Jan 2005
i turned mine into a function so i can call it via my rlg in the future.
Code: #include once "crt.bi"
#define WALL 4
#define FINISH 3
#define START 2
option explicit
option escape
type coord
x as ubyte
y as ubyte
end type
type node
x as ubyte
y as ubyte
g as integer
f as integer
p as node ptr
end type
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
declare function onclosedlist( byref what as coord ) as byte
declare function removefromopenlist( byval idx as integer ) as byte
declare function onopenlist( byref what as coord ) as byte
declare sub _read( byref var as integer )
declare function findpath( room( ) as integer ) as node ptr
redim preserve shared openlist( 0 ) as node ptr, closedlist( 1 ) as coord, allnodes( 0 ) as node ptr
dim as integer rx, ry, i
'dim shared as string yn
'input "show path? [y/n]:", yn
'yn = ucase$( left$( yn, 1 ) )
cls
dim shared as integer mx, my
open "board.brd" for binary as #1
_read mx
_read my
dim as integer room( mx * my )
for ry = 0 to my - 1
for rx = 0 to mx - 1
_read room( rx + ry * mx )
select case room( rx + ry * mx )
case WALL
? "|";
case START
? "@";
closedlist( 0 ).x = rx
closedlist( 0 ).y = ry
case FINISH
? "*";
case else
? " ";
end select
next
?
next
'if yn = "Y" then sleep
dim as node ptr tmpnode
tmpnode = findpath( room( ) )
if tmpnode <> -1 then
while tmpnode <> 0
locate tmpnode->y + 1, tmpnode->x + 1
? "*"
tmpnode = tmpnode->p
wend
else
? "path not found..."
end if
'' it will be necessary to clean up memory afterward, otherwise we'll end up with
'' a leak the size of the pacific ocean ;P
for i = 0 to ubound( allnodes )
deallocate allnodes( i )
next
sleep
end
function findpath( room( ) as integer ) as node ptr
dim as integer i, cx, cy, ex, ey, max = 100
for i = 0 to ubound( room )
if room( i ) = START then cx = i mod mx : cy = i \ mx
if room( i ) = FINISH then ex = i mod mx : ey = i \ mx
next
dim as node ptr tmpnode
tmpnode = callocate( len( node ) )
tmpnode->x = cx
tmpnode->y = cy
allnodes( ubound( allnodes ) ) = tmpnode
redim preserve allnodes( ubound( allnodes ) + 1 )
while cx <> ex or cy <> ey
dim as integer aye, x, y
aye = 0
for x = -1 to 1
for y = -1 to 1 step 1 - ( x = 0 )
dim as coord working
working.x = cx + x
working.y = cy + y
if onclosedlist( working ) = 0 and onopenlist( working ) = 0 and _
room( cx + x + ( cy + y ) * mx ) <> WALL and _
room( cx + ( cy + y ) * mx ) <> WALL and _
room( cx + x + cy * mx ) <> WALL and _
outofbounds( cx + x, cy + y ) = 0 then
openlist( ubound( openlist ) ) = callocate( len( node ) )
dim as node ptr temp
temp = openlist( ubound( openlist ) ) '' use a temp var so we don't have to
'' keep using ubound()
temp->x = working.x
temp->y = working.y
temp->f = 10 * sqr( abs( x ) + abs( y ) ) + _ '' the g score
10 * sqr( ( cx + x - ex ) ^ 2 + ( cy + y - ey ) ^ 2 ) '' the h score
if temp->f > max then max = temp->f
temp->p = tmpnode
allnodes( ubound( allnodes ) ) = temp
redim preserve allnodes( ubound( allnodes ) + 1 )
redim preserve openlist( ubound( openlist ) + 1 )
end if
next
next
dim as integer lowest, lowestidx = 0
lowest = max + 1
for i = 0 to ubound( openlist ) - 1
if openlist( i )->f < lowest and openlist( i )->f <> -1 then
lowest = openlist( i )->f
lowestidx = i
end if
next
'if yn = "Y" then locate cy + 1, cx + 1: ? " "
if lowest <> max + 1 then
cx = openlist( lowestidx )->x
cy = openlist( lowestidx )->y
else
'' path not found, uh oh
return -1
end if
'if yn = "Y" then locate cy + 1, cx + 1: ? "@"
closedlist( ubound( closedlist ) ).x = cx
closedlist( ubound( closedlist ) ).y = cy
redim preserve closedlist( ubound( closedlist ) + 1 )
tmpnode = openlist( lowestidx )
removefromopenlist( lowestidx )
'if yn = "Y" then sleep
wend
return tmpnode
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
function onclosedlist( byref what as coord ) as byte
dim as integer i
for i = 0 to ubound( closedlist ) - 1
if memcmp( @closedlist( i ), @what, len( coord ) ) = 0 then return -1
next
return 0
end function
function removefromopenlist( byval idx as integer ) as byte
if idx > ubound( openlist ) then return 0
dim as integer i
for i = idx to ubound( openlist ) - 1
openlist( i ) = openlist( i + 1 )
next
redim preserve openlist( ubound( openlist ) - 1 )
return -1
end function
function onopenlist( byref what as coord ) as byte
dim as integer i
for i = 0 to ubound( openlist ) - 1
if memcmp( openlist( i ), @what, len( coord ) ) = 0 then return -1
next
return 0
end function
sub _read( byref var as integer )
dim as ubyte char
dim as string thing
get #1, , char
while char <> asc( "," ) and char <> asc( "\n" ) and eof( 1 ) = 0
thing += chr$( char )
get #1, , char
wend
if eof( 1 ) then thing += chr$( char )
var = val( thing )
end sub
map i'm testing it with:
Code: 25,14
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4
4,2,4,0,4,0,0,0,0,0,0,0,0,0,4,0,0,0,0,0,0,0,0,0,4
4,0,4,0,4,0,4,4,4,4,4,4,4,4,4,0,4,4,4,4,4,4,4,0,4
4,0,4,0,4,0,0,0,0,0,0,0,0,0,4,0,4,0,0,0,0,3,4,0,4
4,0,4,0,4,4,4,4,4,4,4,4,4,0,4,0,4,0,4,4,4,4,4,0,4
4,0,4,0,4,0,4,0,0,0,0,0,0,0,4,0,4,0,0,0,0,0,0,0,4
4,0,4,0,4,0,4,0,4,4,4,4,4,4,4,0,4,4,4,4,4,4,4,4,4
4,0,0,0,4,0,4,0,0,0,0,0,0,4,4,0,0,0,0,4,0,4,4,4,4
4,0,4,0,4,0,4,4,4,4,4,4,0,4,4,4,4,4,0,4,0,0,0,0,4
4,0,4,0,4,0,4,4,4,4,4,4,0,4,4,4,4,4,0,4,4,4,4,0,4
4,0,4,0,0,0,0,0,0,0,0,0,0,4,4,4,0,0,0,4,0,0,0,0,4
4,0,4,4,4,4,4,4,4,4,4,4,4,4,4,4,0,4,4,4,0,4,4,4,4
4,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,4
4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4
this map crashes torahteen's on my computer... :???:
ttp://m0n573r.afraid.org/
Quote:quote: "<+whtiger> you... you don't know which way the earth spins?" ... see... stupidity leads to reverence, reverence to shakiness, shakiness to... the dark side
...phear
Posts: 500
Threads: 7
Joined: Jun 2005
That's because the map uses different constants than his program. According to his program, there IS no start or finish (5 and 6, whereas you used 2 and 3). If the program is modified however, it works. Try modifying his constants (commenting out the other stuff).
974277320612072617420666C61696C21 (Hexadecimal for those who don't know)
|