【解决八皇后计算问题】VBA究竟能否解决这类递归回溯问题？

godhands

讨论一个问题，在VBA中，调用一个过程或者函数，使用Call指令，若函数的调用发生在其自身的for或while等循环体内，当全部遍历一遍循环结束后，似乎无法返回（回溯）上一级过程的循环体中继续，而是直接结束本过程或函数。

八皇后问题：将八个皇后摆在一张8*8的国际象棋棋盘上，使每个皇后都无法吃掉别的皇后，一共有多少种摆法？（此问题在1848年由棋手马克斯·贝瑟尔提出）

目前我只能用 for循环这种低效率的办法计算出各个棋谱，代码如下：

Sub 笨办法算八皇后()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim N, 解决方案, j, v, 行
Dim i, i1, i2, i3, i4, i5, i6, i7, i8
Dim a(10)  '定义一个数组
N = 8 '棋盘一共有8行
解决方案 = 0
j = 1
行 = 0

For i1 = 1 To N
    For i2 = 1 To N
        For i3 = 1 To N
                For i4 = 1 To N
                    For i5 = 1 To N
                        For i6 = 1 To N
                            For i7 = 1 To N
                                    For i8 = 1 To N
                                       
                                            a(1) = i1 '第一行 摆在i1列，后面依次类推
                                            a(2) = i2
                                            a(3) = i3
                                            a(4) = i4
                                            a(5) = i5
                                            a(6) = i6
                                            a(7) = i7
                                            a(8) = i8

                                      
                                       For v = 1 To N - 1
                                        j = v + 1  'a1开始和 a[2]往后的值比对
                                       
                                            For i = j To N
                                            If a(v) = a(i) Then '说明有重复值
                                            GoTo line100
                                            End If
                                            Next i

                                       Next v
                                       
                                       '运行至此说明行列无重复
                                       
                                       For v = 1 To N - 1                                 '开始比对两条斜对角线是否重复
                                        j = v + 1  'a1开始和 a[2]往后的值比对
                                       
                                            For i = j To N
                                            If (a(v) + v = a(i) + i) Or (a(v) - v = a(i) - i) Then '说明有重复值             v行 av列  和 i行 vi列 看看在不在一条对角线上
                                            GoTo line100
                                            End If
                                            Next i

                                       Next v
                                                
                                                
                                      解决方案 = 解决方案 + 1
                                      
                                      For i = 1 To N
                                      行 = 行 + 1
                                      Sheet2.Cells(行, a(i)) = "Q"
                                      
                                      
                                      
                                      Next i
                                      
                                      行 = 行 + 1
      

                                       
line100:            '结束循环，说明不满足行列条件
                        
                                    Next i8
                            Next i7
                        Next i6
                    Next i5
                Next i4
        Next i3
    Next i2
Next i1

Debug.Print "解决方案数量： " & 解决方案
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


然而，如果使用 递归，似乎会在第一次找不到解的时候，直接结束循环，而没有办法回溯到上一级过程的循环体中。

不知道大家有没有什么好办法解决这个问题呢？

godhands

关键是 用 for循环，无法将8皇后问题拓展至 N皇后， 而且浪费了很多资源去计算本来通过判断即可直接结束的循环

大家有没有更好的办法？请分享一下吧

zopey

这种基础算法问题 ，百度有很多参考资料。

zopey

作者：Sails
来源：知乎
著作权归作者所有。商业转载请联系作者获得授权，非商业转载请注明出处。

/////////////////////////////////////////////////////////////////////////////////////////////
程序说明-- 如果纠结于皇后之间不能互相攻击，10行内是搞不定的，必须转换问题

对n皇后问题
定义1： 建立(n+2)*(n+2)的棋盘，其中最外围成为壁，共有4*（n+1）个节点，称为壁节点
定义2： 每个皇后定义4种攻击方式：-- | \ / (横线，竖线，左斜线，右斜线)。

定理1： 每个皇后对壁节点攻击8次，每一种攻击各两次。

推论：
情况1： 任意两个皇后之间不能相互攻击
情况2： 任意一个壁节点最多承受4次方式不同攻击当棋盘中存在n个皇后时，情况1 为 情况2 的充分必要条件。

结论：仅需要判断每个壁节点的攻击方式不重复即可。

优化：由于每个皇后攻击的壁节点对称，因此每种攻击仅需一半的攻击节点。--    n|     n\     2*n/    2*n

程序思想：
1. 将n*n的棋盘编号，0 -- n*n-1
2. 判断，当皇后处于位置i时，其4种攻击方式所攻击的壁节点编号
3. 若某壁节点已经被攻击，则皇后不得处于该位置
4. 若无壁节点被重复攻击，则皇后可能处于该位置
5. 采用bit位标注，最大为64bit，因此该函数最多能够解决到10皇后问题
//////////////////////////////////////////////////////////////////////////////////////////////

一把小刀闯天下

'改了一个c++代码，估计差不多自己可以测试一下

'链接地址：https://baike.baidu.com/item/%E5 ... 11053477?fr=aladdin

'可以把Call prn这行注释掉，因为输出不少会影响速度

'test为主过程，要运行它

Option Explicit

Const NUM As Long = 8 '这里为8个皇后

Dim gEightQueen, gCount

Sub test()
  ReDim gEightQueen(NUM)
  gCount = 0
  Call eight_queen(0)
  Debug.Print "total=" & gCount
End Sub

Function prn() '//输出每一种情况下棋盘中皇后的摆放情况
  Dim i, inner
  For i = 0 To NUM - 1
    For inner = 0 To gEightQueen(i) - 1: Debug.Print "0"; "#";: Next
    Debug.Print
    For inner = gEightQueen(i) + 1 To NUM - 1: Debug.Print "0";: Next
  Next
  Debug.Print
  Debug.Print String(NUM * 2, "=")
End Function

Function check_pos_valid(lop, value) As Boolean '//检查是否存在有多个皇后在同一行/列/对角线的情况
  Dim index, data
  For index = 0 To lop - 1
    data = gEightQueen(index)
    If value = data Then Exit Function
    If index + data = lop + value Then Exit Function
    If index - data = lop - value Then Exit Function
  Next
  check_pos_valid = True
End Function

Function eight_queen(index)
  Dim lop
  For lop = 0 To NUM - 1
    If check_pos_valid(index, lop) Then
      gEightQueen(index) = lop
      If NUM - 1 = index Then
        gCount = gCount + 1
        Call prn
        gEightQueen(index) = 0
        Exit Function
      End If
      Call eight_queen(index + 1)
      gEightQueen(index) = 0
    End If
  Next
End Function

godhands

zopey 发表于 2018-9-4 20:24
这种基础算法问题 ，百度有很多参考资料。

问题不在算法……

zopey

n皇后问题

由八皇后问题扩展开来，即n*n的棋盘上摆放n个皇后，使其不能互相攻击，即任意两个皇后都不能处于同一行、同一列或同一斜线上，问有多少种摆法。

分析：

  问题可以转化为12345...n 的满足某种条件(行已不等,列亦不等,只需设定其不在同一斜线上,即斜率不为 1 或-1 )的排列.

以下代码 摘取自NORTHWOLVES 博客：

Private Sub queensn(ByVal n As Integer, ByRef result() As String) '计算n皇后问题的过程
Dim i As Long, J As Integer, k As Integer, number As Long, num As Long '循环变量
Dim FIT As Boolean '判定是否符合条件
Dim ALL(), out() As String '用于输出的数组
ReDim ALL(1 To n)
ReDim out(1 To n)
number = 1
Dim TEMP1 As Long, TEMP2 As Integer '进制转换中间变量
For i = 1 To n
number = number * i ' get n!
Next
For i = 1 To number ' 穷举n!种排列
ALL(1) = 1
TEMP1 = i
For J = 2 To n
TEMP2 = TEMP1 Mod J '混合进制
TEMP1 = TEMP1 / J
If TEMP2 = 0 Then
ALL(J) = J 'temp2为 0则放在最后
Else
For k = J To TEMP2 + 1 Step -1
ALL(k) = ALL(k - 1) ' temp2之后的元素后移一位
Next
ALL(TEMP2) = J 'temp2不为 0 则置于第temp2个元素前
End If
Next '至此得到12345...n的一个排列

FIT = True '初始化变量

'循环判断有否两个皇后存在互吃
For J = 1 To n
For k = n To 1 Step -1
If Not k = J Then
If ALL(k) - ALL(J) = J - k Or ALL(k) - ALL(J) = k - J Then
FIT = False
GoTo pass '跳出循环
End If
End If
Next
Next

If FIT Then '满足条件时
num = num + 1 '输出编号
ReDim Preserve result(1 To num)
For J = 1 To n
out(J) = String(n, StrConv("□", vbWide))
Mid(out(J), ALL(J), 1) = StrConv("Q", vbWide)
Next
result(num) = "第" & num & "种方法:" & vbCrLf & Join(out, vbCrLf) '输出第 num 种 n 个皇后摆放状态
End If
pass:
Next
End Sub

Private Sub Command1_Click()
Dim result() As String
queensn 9, result '九皇后
Open "d:/result.txt" For Binary As #1
Put #1, , Join(result, vbCrLf)
Close #1
MsgBox "ok"
End Sub

godhands

一把小刀闯天下 发表于 2018-9-4 20:49
'改了一个c++代码，估计差不多自己可以测试一下

'链接地址：https://baike.baidu.com/item/%E5%85%AB%E7 ...

靠谱！亲测有效。 原来是这么把参数传进去参与循环的

zopey

7楼生成 全排列数组 all()的代码 测试发现错误，经过替换不良代码后，附件结果正确，输出文件 在d盘 result。

参数在此 ，可以修改：
queensn 9, result '九皇后

queen9.zip (16.6 KB, 下载次数: 3)

2018-9-5 11:58 上传

点击文件名下载附件

microyip

归根结底，题目就是要求各位置处于不同行不同列不同斜线上