Printable View
I’ve attached my attempt at A-Star path finding.
It is suppose to find the shortest path while taking the fewest turns and then draw arrows from start to finish.
I attempted to use a binary heap to sort my F values.
My problem is that the program seems to lockup and I can’t seem to find the cause.
Will someone please take a look at it?
Also, dose anyone have any suggestions on how I can improve this?
You are stuck in an infinite loop in BinaryHeapRemove.
What this boils down to is:Code:Do
If ((CIndex + 1) * 2) <= UBound(PathOpen()) Then
' CIndex = 4, Ubound(PathOpen) = 12
If PathOpen((CIndex + 1) * 2).F <= PathOpen((CIndex * 2) + 1).F _
And PathOpen((CIndex + 1) * 2).F <= PathOpen(CIndex).F Then
' PathOpen(10).F = 1055, PathOpen(9).F = 1065
' PathOpen(10).F = 1055, PathOpen(4).F = 1040
Else
If PathOpen((CIndex * 2) + 1).F <= PathOpen((CIndex + 1) * 2).F _
And PathOpen((CIndex * 2) + 1).F <= PathOpen(CIndex).F Then
' PathOpen(9).F = 1065, PathOpen(10).F = 1055
' PathOpen(9).F = 1065, PathOpen(4).F = 1040
End If 'lower check
End If 'upper check
Else 'dose lower exists?
' clipped for brevity
End If
Loop
You have no case for when A and B are both greater than C. Unfortunately, I am unable to offer any suggestions. Simply providing an Exit Do for this case doesn't solve anything - it may actually cause a bigger problem.Code:If A <= B And A <= C Then
' ...
Else
If B <= A And B <= C then
' ...
End If
End If
Um, wouldn’t A>C & B>C be an invalid heap?
What would the heap look like before the topmost item was removed??
10,30,30,20 is an invalid heap.
10,30,20,30 would be the valid version of the heap.
Let me do some checking to see if my heap is being invalidated somewhere, though I don’t think it is…….
I put this at the end of my BinaryHeapAdd() and didnt find any errors in my heap.
So then I tryed:Code:For CIndex = LBound(PathOpen()) To UBound(PathOpen())
Debug.Print "Parent: " & CIndex & " " & PathOpen(CIndex).F
If ((CIndex + 1) * 2) <= UBound(PathOpen()) Then 'upper present
Debug.Print "Upper: " & ((CIndex + 1) * 2) & " " & PathOpen((CIndex + 1) * 2).F
Debug.Print "lower: " & ((CIndex * 2) + 1) & " " & PathOpen((CIndex * 2) + 1).F
If (PathOpen((CIndex + 1) * 2).F < PathOpen(CIndex).F) Or (PathOpen((CIndex * 2) + 1).F < PathOpen(CIndex).F) Then
Debug.Print "+++++++++++++++++ERROR++++++++++++++++"
End If
Else
If ((CIndex * 2) + 1) <= UBound(PathOpen()) Then 'lower present
Debug.Print "lower: " & ((CIndex * 2) + 1) & " " & PathOpen((CIndex * 2) + 1).F
If (PathOpen((CIndex * 2) + 1).F < PathOpen(CIndex).F) Then
Debug.Print "+++++++++++++++++ERROR++++++++++++++++"
End If
End If
End If
Debug.Print "---------------------------"
Next
Still didn't find anything, so A and B are never bigger than C because C is taken from the end of the heap and is always bigger than eather A or B or both A and B.Code:If (PathOpen(UBound(PathOpen())).F < PathOpen(1).F) And PathOpen(UBound(PathOpen())).F < PathOpen(2).F Then
Debug.Print "+++++++++++++++++ERROR++++++++++++++++"
End If
Here is your heap during the 4th call to BinaryHeapRemove.
1st column: Indices for referenceCode:0 1010 1040 1010 1010
1 1010 1010 1040 1025
2 1035 1035 1035 1035
3 1025 1025 1025 1025
4 1025 1025 1025 1040
5 1035 1035 1035 1035
6 1040 1040 1040 1040
7 1045 1045 1045 1045
8 1040 1040 1040 1040
9 1065 1065 1065 1065
10 1055 1055 1055 1055
11 1040 1040 1040 1040
12 1040 1040 1040 1040
13 1040
2nd column: State of heap at begining of procedure
3rd column: (13) was copied to (0), then removed
4th column: (0) was compared with (1) and (2), then swapped with (1)
5th column: (1) was compared with (3) and (4), then swapped with (4)
End result: (4) is now less than both (9) and (10), causing infinite loop.
I hope this helps to identify your problem. I don't know how this is supposed to work, so I cannot do much more than help you trace the error.
Concept of A* pathfinding:
http://www.policyalmanac.org/games/aStarTutorial.htm
Binary Heaps Explaned:
http://www.policyalmanac.org/games/binaryHeaps.htm
I take it back, A and B wont be bigger than C UNTIL C sinks to its proper place in the heap.
And adding an Exit Do seems to have solved for when both A and B are greater than C, but I still seem to be getting an infinite loop somewhere.....
Code:Do
'check if both children exists
'if the upper exists then the lower exists
Debug.Print "Parent: " & CIndex & " " & PathOpen(CIndex).F
If ((CIndex + 1) * 2) <= UBound(PathOpen()) Then Debug.Print "Upper: " & ((CIndex + 1) * 2) & " " & PathOpen((CIndex + 1) * 2).F
If ((CIndex * 2) + 1) <= UBound(PathOpen()) Then Debug.Print "lower: " & ((CIndex * 2) + 1) & " " & PathOpen((CIndex * 2) + 1).F
Debug.Print "-----------------------"
If ((CIndex + 1) * 2) <= UBound(PathOpen()) Then
'if upper is smaller than lower and upper is smaller than Curent Index
If PathOpen((CIndex + 1) * 2).F <= PathOpen((CIndex * 2) + 1).F And PathOpen((CIndex + 1) * 2).F <= PathOpen(CIndex).F Then
'then swich
.......................
Else
'if upper isn't smaller than lower then
'if lower is smaller than upper and lower is smaller than Current Index
If PathOpen((CIndex * 2) + 1).F <= PathOpen((CIndex + 1) * 2).F And PathOpen((CIndex * 2) + 1).F <= PathOpen(CIndex).F Then
'then swich
...............................
Else
Exit Do
End If 'lower check
End If 'upper check
Else 'dose lower exists?
If ((CIndex * 2) + 1) <= UBound(PathOpen()) Then
'if lower smaller than Current Index
If PathOpen((CIndex * 2) + 1).F < PathOpen(CIndex).F Then
'then swich
...........................
Else
Exit Do
End If 'lower check
Else
Exit Do
End If
End If
Loop
EDIT: What is the best way to find an infinite loop.
I found 2 more bugs:
In IsPathClosed I had the Exit for in the wrong place so that it returned false every time.
In FindAndDrawPath I had BinaryHeapRemove called too late in the function so that the current cornet was at risk of not being removed and added to the closed list.
I've attached what I have so far, but it still has an infinite loop somewhere.......
Can anyone help me spot it??