游戏走123步--解析

最近玩了个游戏，界面大概如下：

3	2	1
1	1	2
2	3	3

玩法介绍： 

从图上的任意值为1的开始走，每个点只能走一遍，只能向上下左右四个方向，不能跳格，走完所有点算赢，这个是个简单的界面，复杂的就是行和列为9*9的矩阵，或者更多

下面给出解法：

Option Explicit
Dim arr() As Integer, res() As Integer   '数据数组和结果数组
Dim s() As Integer  '模拟堆数组
Dim sLen2 As Integer  '堆的二维长度
Dim rowNum As Integer, colNum As Integer  '数组行数和列数
Dim isTrue As Boolean '判断是否成功

Sub main()
initArr
initS
makePath
If isTrue Then
    showArr res
    showPath res
End If
isTrue = False
End Sub

Sub makePath()
    ReDim valin(sLen2) As Integer
    Dim i, j As Integer
    i = 0
    Do While i <= rowNum And isTrue = False
        j = 0
        Do While j <= colNum And isTrue = False
            If arr(i, j) = 1 Then
                'val(row,col,nextValue,dir,order)
                valin = buildVal(i, j, 2, 1, 1)
                's(),val(row,col,nextValue,dir,order)
                push s, valin
                Do While isTrue = False And s(0, 0) > 1
                    Dim valOut() As Integer, x, y As Integer
                    valOut = readS(s)
                    Do While valOut(3) <= 4
                        x = valOut(0)
                        y = valOut(1)
                        Select Case valOut(3)
                        Case 1
                            y = y + 1
                        Case 2
                            x = x + 1
                        Case 3
                            y = y - 1
                        Case 4
                            x = x - 1
                        End Select
                        
                        s(s(0, 0) - 1, 3) = s(s(0, 0) - 1, 3) + 1
                        If x <= UBound(arr) And x >= LBound(arr) And y <= UBound(arr, 2) And y >= LBound(arr, 2) Then
                            If valOut(2) = arr(x, y) And isFooted(x, y) Then
                                valin = buildVal(x, y, (valOut(2) + 1) Mod 3, 1, valOut(4) + 1)
                                push s, valin
                                Exit Do
                            End If
                        End If
                        valOut(3) = valOut(3) + 1
                    Loop
                    If valOut(3) > 4 Then
                    pop s
                    End If
                Loop
                Do While s(0, 0) > 1
                    valOut = pop(s)
                    res(valOut(0), valOut(1)) = valOut(4)
                Loop
            End If
            j = j + 1
        Loop
        i = i + 1
    Loop
End Sub

'行号，
'列号，
'查找下一个值
'方向:1右，2下，3左，4上
'查找总数，用于判断是否全部查找完成，以及输出步骤的序列
Function buildVal(ByVal i As Integer, ByVal j As Integer, ByVal nextValue As Integer, ByVal dir As Integer, ByVal order As Integer)
Dim t() As Integer
ReDim t(sLen2)
t(0) = i
t(1) = j
If nextValue = 0 Then
    t(2) = 3
Else
    t(2) = nextValue
End If
t(3) = dir
t(4) = order
If order = (rowNum + 1) * (colNum + 1) Then
    isTrue = True
End If
buildVal = t
End Function


Sub initS()
    sLen2 = 4
    ReDim s((rowNum + 1) * (colNum + 1) + 1, sLen2)
    Dim i As Integer
    For i = 0 To sLen2
        s(0, i) = 0
    Next i
    s(0, 0) = 1
End Sub

Sub initArr()

rowNum = Sheets("sheet2").UsedRange.Rows.Count - 1
colNum = Sheets("sheet2").UsedRange.Columns.Count - 1
ReDim arr(rowNum, colNum) As Integer
Dim r, c As Integer
For r = 1 To rowNum + 1
    For c = 1 To colNum + 1
        arr(r - 1, c - 1) = Sheets("sheet2").Cells(r, c).Value
    Next c
Next r

ReDim res(rowNum, colNum) As Integer

End Sub

Sub showPath(p() As Integer)
Dim s1 As String, i As Integer, j As Integer
'删除原有数据
ActiveSheet.Range("a1:az100").Select
Selection.Clear
Selection.RowHeight = 15
Selection.ColumnWidth = 8.43
Cells(10, 10).Select
'填充步骤序列
For i = 0 To rowNum
    For j = 0 To colNum
        ActiveSheet.Cells(i + 1, j + 1) = p(i, j)
        ActiveSheet.Cells(i + 1, j + 1).ColumnWidth = 2
        ActiveSheet.Cells(i + 1, j + 1).RowHeight = 15
    Next
Next
End Sub

Sub showArr(ByRef aa() As Integer)
'MsgBox ("数组内容如下：")
Dim s1 As String, i As Integer, j As Integer
For i = 0 To rowNum
    For j = 0 To colNum
        s1 = s1 & aa(i, j) & ","
    Next
    s1 = s1 & vbCrLf
Next
MsgBox (s1)
End Sub

'判断坐标是否已经走过
Function isFooted(ByVal i As Integer, ByVal j As Integer)
    Dim x As Integer
    Dim b As Boolean
    b = True
    For x = 1 To s(0, 0) - 1
        If i = s(x, 0) And j = s(x, 1) Then
            b = False
        End If
    Next x
    isFooted = b
End Function


Function readS(s() As Integer)
    Dim arrLen As Integer, t() As Integer, i As Integer
    arrLen = UBound(s, 2)
    ReDim t(arrLen) As Integer
    If s(0, 0) > 1 Then
        For i = 0 To arrLen
            t(i) = s((s(0, 0) - 1), i)
        Next i
    Else
        For i = 0 To arrLen
            t(i) = -1
        Next i
    End If
    readS = t
End Function

Function pop(s() As Integer)
    Dim arrLen As Integer, t() As Integer, i As Integer
    arrLen = UBound(s, 2)
    ReDim t(arrLen) As Integer
    If s(0, 0) > 1 Then
        s(0, 0) = s(0, 0) - 1
        For i = 0 To arrLen
            t(i) = s(s(0, 0), i)
        Next i
    Else
        For i = 0 To arrLen
            t(i) = -1
        Next i
    End If
    pop = t
End Function

Function push(s() As Integer, val() As Integer)
    Dim arrLen As Integer, i As Integer
    arrLen = UBound(val)
    For i = 0 To arrLen
        s(s(0, 0), i) = val(i)
    Next i
    s(0, 0) = s(0, 0) + 1
End Function