Question

我正在尝试在vba中找到迷宫的路径，这是迷宫的照片，红色是路径，黑色是墙壁，它应该生成通往绿色的路径。我尝试在这个问题中使用BFS。这是代码。请帮我！我大多数时候尝试此代码，但返回失败

sub FindPath()
    Dim currentRow, currentCol As Integer
    Dim nextRow, nextCol As Integer
    Dim isEnd As Boolean
    Dim visted As Object
    Set visted = CreateObject("System.Collections.ArrayList")

    Dim Tovisted As Object
    Set Tovisted = CreateObject("System.Collections.ArrayList") 
    Dim temstore As Variant
    currentRow = 2 currentCol = 2 ' TODO: Check whether the source location is dead block

    If isSafeToMove(currentRow + 1, currentCol) = False And IsSafeToMove(currentRow, currentCol + 1) = False Then

         Cells(currentRow, currentCol).Interior.ColorIndex = 5
         MsgBox "No Solution"

    Else
         currentRow = 2
         currentCol = 2

         nextRow = 2
         nextCol = 2

         isEnd = False
     ' TODO: check whether reach the destination yet and the game is not
     '       end yet
        While isEnd = False
            Dim i As Long
            For i = 0 To visted.count - 1
                If currentRow & currentCol <> visted(i) Then

                    Cells(currentRow, currentCol).Interior.ColorIndex = 3
                    visted.Add currentRow & currentCol

                    If currentRow = 5 And currentCol = 5 Then

                       isEnd = True
                       Cells(5, 5).Interior.ColorIndex = 4

                    ElseIf isSafeToMove(currentRow + 1, currentCol) = True Then

                        Cells(currentRow, currentCol).Interior.ColorIndex = 3
                        currentRow = currentRow + 1
                        Tovisted.Add currentRow & currentCol

                    ElseIf isSafeToMove(currentRow, currentCol + 1) = True Then
                        Cells(currentRow, currentCol).Interior.ColorIndex = 3

                        currentCol = currentCol + 1
                        Tovisted.Add currentRow & currentCol
                    End If
                End If

            Next i

            If Tovisted.count > 0 Then

                Tovisted(Tovisted.count - 1) = temstore
                currentRow = Left(temstore, 1)
                currentCol = Right(temstore, 1)

            Else

                MsgBox "Fail"
                isEnd = True

            End If
        Wend 
    End If 
End Sub

Answer 1

想象下面的迷宫，其起始于B2，目标为M9：

以下伪代码用于实现 Breadth-first search algorithm

BFS(start_node, goal_node) {
 for(all nodes i) visited[i] = false; // no nodes are visited in the beginning
 queue.push(start_node);              // begin with start node
 visited[start_node] = true;
 while(! queue.empty() ) {            // as long as queue is not empty
  node = queue.pop();                 // take first element of the queue
  if(node == goal_node) {
   return true;                       // test if goal node is found
  }
  foreach(child in expand(node)) {    // all following nodes, …
   if(visited[child] == false) {      // … which are not visited yet …
    queue.push(child);                // … are added to the queue …
    visited[child] = true;            // … and marked as visited
   }
  }
 }
 return false;                        // goal node cannot be reached
}

我对BFS的实现来找到迷宫的目标单元格：

Public Sub BFS(ByVal StartNode As Range, ByVal GoalNode As Range)
    Dim Queue As Object
    Set Queue = CreateObject("System.Collections.ArrayList")

    Dim VisitedNodes As Collection
    Set VisitedNodes = New Collection  'no nodes are visited yet

    Queue.Add StartNode  'begin with start node
    VisitedNodes.Add StartNode.Address(False, False), StartNode.Address(False, False)

    Do While Queue.Count > 0  'as long as queue is not empty
        Dim Node As Range 
        Set Node = Queue(0)   'take first element of the queue
        Queue.RemoveAt 0

        If Node.Address = GoalNode.Address Then  'test if goal node is found
            MsgBox "Goal found"

            'Backtracing from goal to start to find the path
            Dim BackNode As String
            BackNode = Node.Address(False, False)
            Do
                Range(BackNode).Value = "•"
                BackNode = VisitedNodes.Item(BackNode)
            Loop While BackNode <> StartNode.Address(False, False)

            StartNode.Value = "S"
            GoalNode.Value = "G"

            Exit Sub

        Else   'all following nodes, …

            Dim Child As Range
            For Each Child In Union(Node.Offset(0, -1), Node.Offset(-1, 0), Node.Offset(0, 1), Node.Offset(1, 0)).Cells ' … which are adjacent cells (no diagonal cells, just left, top, right, bottom) …
                If Child.Interior.Color <> vbBlack Then  '… which are no maze borders …
                    If Not ExistsInCollection(VisitedNodes, Child.Address(False, False)) Then   '… which are not visited yet …
                        Queue.Add Child  '… are added to the queue …
                        VisitedNodes.Add Node.Address(False, False), Child.Address(False, False)  '… and marked as visited
                    End If
                End If
            Next Child

        End If
    Loop

    MsgBox "Goal cannot be found."  'goal node cannot be reached
End Sub


'function to test if a key exists in a collection
Public Function ExistsInCollection(Col As Collection, Key As Variant) As Boolean
    On Error GoTo err
    ExistsInCollection = True
    IsObject Col.Item(Key)
    Exit Function
err:
    ExistsInCollection = False
End Function

然后您使用以下命令启动BFS

BFS StartNode:=Range("B2"), GoalNode:=Range("M9")

您将得到以下结果：

一些注意事项：

迷宫必须通过将细胞涂成黑色来构建。
迷宫需要有一个完整的黑色边框来围住算法。否则，它将使整个工作表的单元疯狂。
BFS通常只是告诉您是否可以实现目标。为了获得从起点到目标的路径，我添加了向后追踪部分，该部分向后移动了最短的路径。

VBA迷宫查找路径

1 个答案: