骑士游历/knight tour - visual basic 解决

在visual baisc 6 how to program 中文版第七章的练习题上看到了这个问题，骑士游历的问题。

在8x8的国际象棋的棋盘上，骑士（走法：一个方向走两格，另一个方向一格）不重复走完棋盘上所有空格的路径。

思路就是选角落的一格为起点，把所有能走的路全部路径全部试一遍。要试8^63次，计算时间太长了。把棋盘调成5x5的，比较好算。另外书里提示，根据空格的可访问的难易（难易由周围可访问它的空格数来决定），先选择更难访问的空格访问。

下面是完全遍历一遍的方法。

Option Explicit
Option Base 1

Dim stepmax As Integer
Const n = 8
Dim anw As Integer

Private Sub Command1_Click()

    Dim x As Integer
    Dim y As Integer

    Dim step As Integer
    Dim c(n, n) As Integer

    x = 1
    y = 1
    step = 1

    c(x, y) = step

    Call knightsol(x, y, step, c())
    Text2.Text = stepmax
    Label1.Caption = anw
End Sub

Private Sub knightsol(ByVal x As Integer, ByVal y As Integer, ByVal step As Integer, c() As Integer)
    Dim i As Integer
    Dim xt As Integer, yt As Integer, stept As Integer
    'List1.AddItem ("-------------------------")

    For i = 1 To 8
        xt = x
        yt = y
        stept = step
        'List1.AddItem ("当前位置为" & "(" & x & "," & y & ")")
        Call mv(i, x, y)
        'List1.AddItem ("-- 往" & i & "方向移动到" & "(" & x & "," & y & ")")
        If x > 0 And x <= n And y > 0 And y <= n Then
            If c(x, y) = 0 Then
                step = step + 1
                c(x, y) = step
                'List1.AddItem ("-- 赋值" & x & "," & y & "为" & step)
                If step > stepmax Then
                    stepmax = step
                End If

                If step = n * n Then
                    'List1.AddItem ("目的完成输出路径")
                    'List1.AddItem ("-------------")
                    Call path(c())
                    c(x, y) = 0
                    MsgBox ("找到了")
                    anw = anw + 1
                    Exit Sub
                End If
                Call knightsol(x, y, step, c())
                'Call path(c())
                'List1.AddItem ("还原c(" & x & "," & y & ")")
                c(x, y) = 0
                x = xt
                y = yt
                step = stept
                'List1.AddItem ("-------------------------")
            Else
                'List1.AddItem ("** 被占用了")
                x = xt
                y = yt
            End If
        Else
            'List1.AddItem ("** 越界了")
            x = xt
            y = yt
        End If
    Next

End Sub

Private Sub mv(i As Integer, x As Integer, y As Integer)

    Select Case i
    Case 1
        x = x + 2
        y = y + 1
    Case 2
        x = x + 2
        y = y - 1
    Case 3
        x = x - 2
        y = y + 1
    Case 4
        x = x - 2
        y = y - 1
    Case 5
        x = x + 1
        y = y + 2
    Case 6
        x = x + 1
        y = y - 2
    Case 7
        x = x - 1
        y = y + 2
    Case 8
        x = x - 1
        y = y - 2
    End Select

End Sub

Private Sub path(c() As Integer)
    Dim a As Integer, b As Integer
    For a = 1 To n
        For b = 1 To n
            Text1.Text = Text1.Text & Format(c(a, b), "@@@")
        Next b
        Text1.Text = Text1.Text & vbCrLf
    Next a
    Text1.Text = Text1.Text & vbCrLf
End Sub