8皇后排列问题

aoe1981 · 发表于 2014-10-4 00:13

香川群子发表于 2014-8-21 16:37
关于二维数组矩阵的旋转、转置，一共有8种。

4个顶点从左上开始，按顺时针合并、则起始基本型记录为：ab ...

也学着做了一个这样的示例：
http://club.excelhome.net/forum. ... 193&pid=7879007
但是我们的方法不同，结果略有差异，但8种基本情形是一致的，只是出现的顺序有所不同……

aoe1981 · 发表于 2014-10-4 14:25

香川大侠：
这是我用我的代码得到的8皇后问题的12个基本解：

1	1,13,24,30,35,47,50,60
2	1,14,24,27,39,44,50,61
3	2,12,22,32,35,41,55,61
4	2,13,23,25,35,48,54,60
5	2,13,23,28,33,48,54,59
6	2,14,17,31,36,48,51,61
7	2,14,24,27,33,44,55,61
8	2,15,19,30,40,45,49,60
9	2,15,21,32,33,44,54,59
10	3,13,18,32,33,47,52,62
11	3,13,24,28,33,47,50,62
12	3,14,18,29,40,41,55,60

由于想做一个基本解的直观演示，以及发现了我的旋转、对称变换自定义函数的一个BUG，需再花一些时间，暂时就先不上附件了……

aoe1981 · 发表于 2014-10-4 14:51

本帖最后由 aoe1981 于 2014-10-4 16:34 编辑

　　OK，分步演示基本解已做完，附件可以上传：
　　

8皇后排列问题（aoe1981正式版）（去重加直观演示）.rar (24.68 KB, 下载次数: 158)
　　至于变换自定义函数的BUG另行说明并解决，在该附件中的使用不受影响。

　　自定义函数的BUG已解决，附件已更新。（2014－10－04　16：32）
　　http://club.excelhome.net/forum. ... 193&pid=7879480

aoe1981 · 发表于 2014-10-4 14:52

　　附件内容截图如下：
　　

aoe1981 · 发表于 2014-10-4 14:55

与去重相关的代码：

Public Sub quchong() '去重
If cx <> 1 Then MsgBox "请先进行快速筛选！", , "友情提示": Exit Sub
Dim h%, i%, j%, i1%, j1%, k%, l%, n%, m%, zhs%, s, s1$, arr, brr, qp1, bhjd%, bhlx%, x% '对应序号与坐标
Range("p2:q" & Rows.Count).ClearContents
n = 8 '皇后数
ReDim xh(1 To n ^ 2, 1 To 2), qp(1 To n, 1 To n)
m = 0
For i1 = 1 To n
For j1 = 1 To n
m = m + 1
xh(m, 1) = i1: xh(m, 2) = j1 '记录值的坐标
Next j1
Next i1
arr = Range("k2:k" & Range("k2").End(xlDown).Row).Value
zhs = UBound(arr) '组合数
For i = 1 To zhs - 1
If arr(i, 1) <> "" Then
s = Split(arr(i, 1), ",")
For i1 = 1 To n
For j1 = 1 To n
qp(i1, j1) = 0 '棋盘初始化，必须初始化为0，不能为""，否则变换函数返回值会出错
Next j1
Next i1
For j = LBound(s) To UBound(s)
qp(xh(s(j), 1), xh(s(j), 2)) = s(j) '这个嵌套的费事：棋盘落子情况
Next j
For l = 1 To 7 '每种棋盘状况经历7种变换
bhjd = Choose(l, 90, 180, 270, 45, 90, 135, 180) '变换角度
If l < 4 Then bhlx = 1 Else bhlx = 2 '变换类型
qp1 = BianHuan(qp, bhjd, bhlx) '变换棋盘
m = 0: s1 = ""
For j = 1 To n
For k = 1 To n
m = m + 1
If qp1(j, k) <> 0 Then qp1(j, k) = m: s1 = s1 & qp1(j, k) & "," '调整棋子序号，连接变换后的字符串
Next k
Next j
s1 = Left(s1, Len(s1) - 1)
For h = i + 1 To zhs '剔除重复组合
If arr(h, 1) = s1 Then arr(h, 1) = "": x = x + 1: Exit For
Next h
Next l
End If
Next i
ReDim brr(1 To zhs - x, 1)
m = 0
For i = 1 To zhs
If arr(i, 1) <> "" Then m = m + 1: brr(m, 0) = m: brr(m, 1) = arr(i, 1)
Next i
Range("p2").Resize(UBound(brr) - LBound(brr) + 1, UBound(brr, 2) - LBound(brr, 2) + 1) = brr
cx = 0
Dim xz%, zhd% '选择、中断
xz = MsgBox("是否进行直观演示？", vbYesNo, "友情提示")
If xz = vbNo Then Exit Sub
zhd = 0
For i = 1 To zhs - x
Range(Cells(1, 1), Cells(8, 8)).ClearContents
s = Split(brr(i, 1), ",")
For j = LBound(s) To UBound(s)
Cells(xh(s(j), 1), xh(s(j), 2)).Value = "●"
Next j
If zhd = 0 Then
xz = MsgBox("这是第" & brr(i, 0) & "种结果" & Chr(10) & "是否继续分步演示？", vbYesNo, "友情提示")
If xz = vbNo Then zhd = 1
End If
Next i
End Sub

复制代码

下面是上段代码调用的变换自定义函数，改成了数组形式（想来您指导过既可以使用单元格区域的，也可以使用内存数组的，后面一并研究）：

Public Function BianHuan(rng, jd%, Optional n% = 1) '旋转和对称变换自定义函数
Dim arr, h%, l%, i%, j%, hl%, x!, y!, hd#, h1%, l1%, m%, k%
arr = rng '原始数据数组
h = UBound(arr): l = UBound(arr, 2)
If n = 1 Then
If jd = 90 Then jd = 270 Else If jd = 270 Then jd = 90 '工作表其实是第四象限，相当于转为第一象限
ElseIf n = 2 Then
If jd = 45 Then jd = 135 Else If jd = 135 Then jd = 45 '工作表其实是第四象限，相当于转为第一象限
End If
hl = WorksheetFunction.Max(h, l): hd = jd / 180 * Application.Pi()
ReDim brr(-hl To hl, -hl To hl) '过渡数组
For i = 1 To h '对应y
For j = 1 To l '对应x
If n = 1 Then
x = j * Cos(hd) - i * Sin(hd)
y = j * Sin(hd) + i * Cos(hd)
brr(y, x) = arr(i, j)
ElseIf n = 2 Then
x = j * Cos(hd * 2) + i * Sin(hd * 2)
y = j * Sin(hd * 2) - i * Cos(hd * 2)
brr(y, x) = arr(i, j)
End If
Next j
Next i
h1 = 0: l1 = 0
For i = -hl To hl '非空列
m = 0
For j = -hl To hl
If brr(i, j) <> "" Then m = m + 1
Next j
If l1 < m Then l1 = m
Next i
If l1 = l Then h1 = h Else h1 = l '非空行
ReDim crr(1 To h1, 1 To l1)
m = 0: k = 1
For i = -hl To hl '剔除brr中的空值，保留非空值位置
For j = -hl To hl
If brr(i, j) <> "" Then m = m + 1: crr(k, m) = brr(i, j)
Next j
If m <> 0 Then k = k + 1
m = 0
Next i
BianHuan = crr
End Function

复制代码

香川群子 · 发表于 2014-10-9 16:37

本帖最后由香川群子于 2014-10-11 10:17 编辑

括号问题通过递归算法终于解决。

1/2/3 有3种:
1/2/3; (1/2)/3; 1/(2/3)

1/2/3/4有12种：
1/2/3/4;(1/2)/3/4;(1/2)/(3/4);(1/2/3)/4;
((1/2)/3)/4;(1/(2/3))/4;1/(2/3)/4;1/(2/3/4);
1/((2/3)/4);1/(2/(3/4));1/2/(3/4);(1/2)/(3/4)

括号组合数
1
1
3
12
52
234
1022
4546
20226

().zip (20.79 KB, 下载次数: 29)

旺旺家 · 发表于 2014-10-15 08:45

路过，学习了。

aoe1981 · 发表于 2018-1-31 15:15

　　时隔多年，再做n皇后，才发现这是一个经典的问题，也终于使用了递归，算是高级了一些吧。看看以前发的帖子，很是惭愧。今日所用思路，可能与39楼：
　　http://club.excelhome.net/forum. ... 010&pid=7816835
　　49楼：
　　http://club.excelhome.net/forum. ... 010&pid=7872310
　　lee1892大师的思路类似吧。
　　代码如下：

Option Explicit
Dim n%, pd%(), jg$(), k&
Sub nHH() 'n皇后
Dim t#, i%
t = Timer
n = Range("b1").Value
k = 0
For i = 1 To n
ReDim pd(1 To n, 1 To n)
Call DG(1, i, "" & i)
Next i
MsgBox "共用时：" & Timer - t & "秒，一共有：" & k & "个结果。"
Columns("g:g").ClearContents
If k = 0 Then Range("g1").Value = "无" Else Range("g1").Resize(k, 1).Value = WorksheetFunction.Transpose(jg)
End Sub
Sub DG(h%, l%, s$) '递归
Dim i%
If h = n Then '检索到第n行时停止向下递归
For i = 1 To n
If pd(h, i) = 0 Then
k = k + 1
ReDim Preserve jg$(1 To k)
jg(k) = s
End If
Next i
Else
Call bj1(h, l) '先标记再检索
For i = 1 To n
If pd(h + 1, i) = 0 Then
Call DG(h + 1, i, s & "," & h * n + i)
Call bj0(h + 1, i) '回溯时取消标记
End If
Next i
End If
End Sub
Sub bj1(h%, l%) '添加标记
Dim i%
For i = h + 1 To n '同列下
If pd(i, l) = 0 Then pd(i, l) = h
Next i
For i = l - 1 To 1 Step -1 '左下斜线
If h + l - i > n Then Exit For Else If pd(h + l - i, i) = 0 Then pd(h + l - i, i) = h
Next i
For i = l + 1 To n '右下斜线
If h + i - l > n Then Exit For Else If pd(h + i - l, i) = 0 Then pd(h + i - l, i) = h
Next i
End Sub
Sub bj0(h%, l%) '取消标记
Dim i%
For i = h + 1 To n '同列下
If pd(i, l) = h Then pd(i, l) = 0
Next i
For i = l - 1 To 1 Step -1 '左下斜线
If h + l - i > n Then Exit For Else If pd(h + l - i, i) = h Then pd(h + l - i, i) = 0
Next i
For i = l + 1 To n '右下斜线
If h + i - l > n Then Exit For Else If pd(h + i - l, i) = h Then pd(h + i - l, i) = 0
Next i
End Sub

复制代码

　　附件如下：
　　

再做n皇后.zip (215.37 KB, 下载次数: 126)

　　特点：
　　1.也是一揽子解决n皇后问题（理论上，实际来说，由于效率及时空复杂度，n过大时也力不能及）；
　　2.输出结果与香川大侠的结果保持一致；
　　3.没有考虑输出基本解；
　　4.运行效率似乎优于lee1892大师的，但不及香川大侠的。

aoe1981 · 发表于 2018-1-31 15:24

lee1892 发表于 2014-8-21 23:32
你不是用的禁忌搜索的办法？

我想象中是按行向下搜索，每选定一个就把后面可能放的格子给去掉，深度优 ...

做了一个与您的思路类似的附件……58楼

aimisiyou · 发表于 2020-3-25 17:08

$ (defun f(n)
(defun check(nlst k)
  (setq i 0)
  (setq num (+ 1 (length nlst)))
  (setq slst (mapcar '(lambda (x) (list (setq i (+ i 1)) x)) nlst))
  (if (or (member k nlst) (= 0 (apply '*(mapcar '(lambda (y) (if (= (- num (car y)) (abs (- k (cadr y)))) 0 1)) slst))))  (setq vt nil) (setq vt t))
  vt
)
(setq j n flst nil)
(while (> j 0)
(setq flst (cons (list j) flst))
(setq j (- j 1))
)
(setq ii 1)
(while (< ii n)
  (setq bestlst nil)
            (foreach en flst
            (setq jj 1 valst nil)
            (while (<= jj n)
                  (if (check en jj)
                              (progn
                                 (setq valst (cons (reverse (cons jj (reverse en))) valst))
                                          (setq jj (+ jj 1))
                                       )
                                       (setq jj (+ jj 1))
                           )
                              )
            (setq bestlst (append valst bestlst))
                     )
(setq flst bestlst)
(setq ii (+ ii 1))
)
flst
)
F
_$ (f 4)
((3 1 4 2) (2 4 1 3))
_$ (f 5)
((1 3 5 2 4) (1 4 2 5 3) (2 4 1 3 5) (2 5 3 1 4) (3 1 4 2 5) (3 5 2 4 1) (4 1 3 5 2) (4 2 5 3 1) (5 2 4 1 3) (5 3 1 4 2))
_$ (f 6)
((5 3 1 6 4 2) (4 1 5 2 6 3) (3 6 2 5 1 4) (2 4 6 1 3 5))
_$ (f 7)
((1 3 5 7 2 4 6) (1 4 7 3 6 2 5) (1 5 2 6 3 7 4) (1 6 4 2 7 5 3) (2 4 6 1 3 5 7) (2 4 1 7 5 3 6) (2 5 7 4 1 3 6) (2 5 3 1 7 4 6) (2 5 1 4 7 3 6) (2 6 3 7 4 1 5) (2 7 5 3 1 6 4) (3 1 6 2 5 7 4) (3 1 6 4 2 7 5) (3 5 7 2 4 6 1) (3 6 2 5 1 4 7) (3 7 4 1 5 2 6) (3 7 2 4 6 1 5) (4 1 5 2 6 3 7) (4 1 3 6 2 7 5) (4 2 7 5 3 1 6) (4 6 1 3 5 7 2) (4 7 5 2 6 1 3) (4 7 3 6 2 5 1) (5 1 6 4 2 7 3) (5 1 4 7 3 6 2) (5 2 6 3 7 4 1) (5 3 1 6 4 2 7) (5 7 2 4 6 1 3) (5 7 2 6 3 1 4) (6 1 3 5 7 2 4) (6 2 5 1 4 7 3) (6 3 7 4 1 5 2) (6 3 5 7 1 4 2) (6 3 1 4 7 5 2) (6 4 7 1 3 5 2) (6 4 2 7 5 3 1) (7 2 4 6 1 3 5) (7 3 6 2 5 1 4) (7 4 1 5 2 6 3) (7 5 3 1 6 4 2))
_$ (f 8)
((8 4 1 3 6 2 7 5) (8 3 1 6 2 5 7 4) (8 2 4 1 7 5 3 6) (8 2 5 3 1 7 4 6) (7 5 3 1 6 8 2 4) (7 4 2 8 6 1 3 5) (7 4 2 5 8 1 3 6) (7 3 1 6 8 5 2 4) (7 3 8 2 5 1 6 4) (7 2 4 1 8 5 3 6) (7 2 6 3 1 4 8 5) (7 1 3 8 6 4 2 5) (6 8 2 4 1 7 5 3) (6 4 1 5 8 2 7 3) (6 4 2 8 5 7 1 3) (6 4 7 1 3 5 2 8) (6 4 7 1 8 2 5 3) (6 3 1 8 4 2 7 5) (6 3 1 8 5 2 4 7) (6 3 1 7 5 8 2 4) (6 3 5 8 1 4 2 7) (6 3 5 7 1 4 2 8) (6 3 7 4 1 8 2 5) (6 3 7 2 4 8 1 5) (6 3 7 2 8 5 1 4) (6 2 7 1 3 5 8 4) (6 2 7 1 4 8 5 3) (6 1 5 2 8 3 7 4) (5 8 4 1 3 6 2 7) (5 8 4 1 7 2 6 3) (5 7 1 4 2 8 6 3) (5 7 1 3 8 6 4 2) (5 7 2 6 3 1 4 8) (5 7 2 6 3 1 8 4) (5 7 2 4 8 1 3 6) (5 7 4 1 3 8 6 2) (5 3 1 7 2 8 6 4) (5 3 1 6 8 2 4 7) (5 3 8 4 7 1 6 2) (5 2 4 7 3 8 6 1) (5 2 4 6 8 3 1 7) (5 2 6 1 7 4 8 3) (5 2 8 1 4 7 3 6) (5 1 4 6 8 2 7 3) (5 1 8 6 3 7 2 4) (5 1 8 4 2 7 3 6) (4 8 1 5 7 2 6 3) (4 8 1 3 6 2 7 5) (4 8 5 3 1 7 2 6) (4 7 1 8 5 2 6 3) (4 7 3 8 2 5 1 6) (4 7 5 3 1 6 8 2) (4 7 5 2 6 1 3 8) (4 6 1 5 2 8 3 7) (4 6 8 3 1 7 5 2) (4 6 8 2 7 1 3 5) (4 2 5 8 6 1 3 7) (4 2 7 5 1 8 6 3) (4 2 7 3 6 8 1 5) (4 2 7 3 6 8 5 1) (4 2 8 6 1 3 5 7) (4 2 8 5 7 1 3 6) (4 1 5 8 2 7 3 6) (4 1 5 8 6 3 7 2) (3 8 4 7 1 6 2 5) (3 7 2 8 5 1 4 6) (3 7 2 8 6 4 1 5) (3 6 2 7 1 4 8 5) (3 6 2 7 5 1 8 4) (3 6 2 5 8 1 7 4) (3 6 4 2 8 5 7 1) (3 6 4 1 8 5 7 2) (3 6 8 2 4 1 7 5) (3 6 8 1 4 7 5 2) (3 6 8 1 5 7 2 4) (3 5 2 8 1 7 4 6) (3 5 2 8 6 4 7 1) (3 5 7 1 4 2 8 6) (3 5 8 4 1 7 2 6) (3 1 7 5 8 2 4 6) (2 8 6 1 3 5 7 4) (2 7 3 6 8 5 1 4) (2 7 5 8 1 4 6 3) (2 6 1 7 4 8 3 5) (2 6 8 3 1 4 7 5) (2 5 7 4 1 8 6 3) (2 5 7 1 3 8 6 4) (2 4 6 8 3 1 7 5) (1 7 4 6 8 2 5 3) (1 7 5 8 2 4 6 3) (1 6 8 3 7 4 2 5) (1 5 8 6 3 7 2 4))

_$ (length (f 1))
1
_$ (length (f 2))
0
_$ (length (f 3))
0
_$ (length (f 4))
2
_$ (length (f 5))
10
_$ (length (f 6))
4
_$ (length (f 7))
40
_$ (length (f 8))
92
_$ (length (f 9))
352
_$ (length (f 10))
724
_$

		自动登录	找回密码
密码			免费注册

[原创] 8皇后排列问题