Ok, I switched everything to Point (so embarrassed to have not thought of that myself) and I got a 37.5% speed increase. Here is the new code.
Also, when I said "mere seconds" earlier I was exaggerating. My benchmarking puts 6x6 at ~0.85 seconds for the old method and ~0.55 seconds for the new method. I did a 100 x 100 grid in ~21 seconds.Code:Sub Neighbors(ByVal Path As List(Of Point)) Dim x As Integer = Path(Path.Count - 1).X Dim y As Integer = Path(Path.Count - 1).Y Dim Up As Point = New Point(x, y - 1) Dim UpRight As Point = New Point(x + 1, y - 1) Dim Right As Point = New Point(x + 1, y) Dim DownRight As Point = New Point(x + 1, y + 1) Dim Down As Point = New Point(x, y + 1) Dim DownLeft As Point = New Point(x - 1, y + 1) Dim Left As Point = New Point(x - 1, y) Dim UpLeft As Point = New Point(x - 1, y - 1) PathQ.RemoveAt(0) If y - 1 >= 0 AndAlso Not Path.Contains(Up) Then CheckPath(Path, Up) 'Up If y - 1 >= 0 AndAlso x + 1 <= xLimit AndAlso Not Path.Contains(UpRight) Then CheckPath(Path, UpRight) 'Up Right If x + 1 <= xLimit AndAlso Not Path.Contains(Right) Then CheckPath(Path, Right) 'Right If x + 1 <= xLimit AndAlso y + 1 <= yLimit AndAlso Not Path.Contains(DownRight) Then CheckPath(Path, DownRight) 'Down Right If y + 1 <= yLimit AndAlso Not Path.Contains(Down) Then CheckPath(Path, Down) 'Down If x - 1 >= 0 AndAlso y + 1 <= yLimit AndAlso Not Path.Contains(DownLeft) Then CheckPath(Path, DownLeft) 'Down Left If x - 1 >= 0 AndAlso Not Path.Contains(Left) Then CheckPath(Path, Left) 'Left If x - 1 >= 0 AndAlso y - 1 >= 0 AndAlso Not Path.Contains(UpLeft) Then CheckPath(Path, UpLeft) 'Up Left While PathQ.Count > 0 Neighbors(PathQ(0)) End While End Sub
Also note that I am checking for a dictionary key each time CheckPath is called. That may be why my numbers seem high.




Reply With Quote