I need help with my A* path finding program.

[Tontow]

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?

[Logophobic]

You are stuck in an infinite loop in BinaryHeapRemove.

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

What this boils down to is:

If A <= B And A <= C Then
  ' ...
Else
  If B <= A And B <= C then
    ' ...
  End If
End If

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.

[Tontow]

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…….

[Tontow]

I put this at the end of my BinaryHeapAdd() and didnt find any errors in my heap.

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

So then I tryed:

If (PathOpen(UBound(PathOpen())).F < PathOpen(1).F) And PathOpen(UBound(PathOpen())).F < PathOpen(2).F Then
    Debug.Print "+++++++++++++++++ERROR++++++++++++++++"
End If

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.

[Logophobic]

Here is your heap during the 4th call to BinaryHeapRemove.

  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

1st column: Indices for reference
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.

[Tontow]

Concept of A* pathfinding:
http://www.policyalmanac.org/games/aStarTutorial.htm

Binary Heaps Explaned:
http://www.policyalmanac.org/games/binaryHeaps.htm

[Tontow]

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.....

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.

[Tontow]

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??