在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