8皇后排列问题

aoe1981

　　这是我得到的具体结果：
序号        结果
1        11，25，38，46，53，67，72，84
2        11，26，38，43，57，64，72，85
3        11，27，34，46，58，62，75，83
4        11，27，35，48，52，64，76，83
5        12，24，36，48，53，61，77，85
6        12，25，37，41，53，68，76，84
7        12，25，37，44，51，68，76，83
8        12，26，31，47，54，68，73，85
9        12，26，38，43，51，64，77，85
10        12，27，33，46，58，65，71，84
11        12，27，35，48，51，64，76，83
12        12，28，36，41，53，65，77，84
13        13，21，37，45，58，62，74，86
14        13，25，32，48，51，67，74，86
15        13，25，32，48，56，64，77，81
16        13，25，37，41，54，62，78，86
17        13，25，38，44，51，67，72，86
18        13，26，32，45，58，61，77，84
19        13，26，32，47，51，64，78，85
20        13，26，32，47，55，61，78，84
21        13，26，34，41，58，65，77，82
22        13，26，34，42，58，65，77，81
23        13，26，38，41，54，67，75，82
24        13，26，38，41，55，67，72，84
25        13，26，38，42，54，61，77，85
26        13，27，32，48，55，61，74，86
27        13，27，32，48，56，64，71，85
28        13，28，34，47，51，66，72，85
29        14，21，35，48，52，67，73，86
30        14，21，35，48，56，63，77，82
31        14，22，35，48，56，61，73，87
32        14，22，37，43，56，68，71，85
33        14，22，37，43，56，68，75，81
34        14，22，37，45，51，68，76，83
35        14，22，38，45，57，61，73，86
36        14，22，38，46，51，63，75，87
37        14，26，31，45，52，68，73，87
38        14，26，38，42，57，61，73，85
39        14，26，38，43，51，67，75，82
40        14，27，31，48，55，62，76，83
41        14，27，33，48，52，65，71，86
42        14，27，35，42，56，61，73，88
43        14，27，35，43，51，66，78，82
44        14，28，31，43，56，62，77，85
45        14，28，31，45，57，62，76，83
46        14，28，35，43，51，67，72，86
47        15，21，34，46，58，62，77，83
48        15，21，38，44，52，67，73，86
49        15，21，38，46，53，67，72，84
50        15，22，34，46，58，63，71，87
51        15，22，34，47，53，68，76，81
52        15，22，36，41，57，64，78，83
53        15，22，38，41，54，67，73，86
54        15，23，31，46，58，62，74，87
55        15，23，31，47，52，68，76，84
56        15，23，38，44，57，61，76，82
57        15，27，31，43，58，66，74，82
58        15，27，31，44，52，68，76，83
59        15，27，32，44，58，61，73，86
60        15，27，32，46，53，61，74，88
61        15，27，32，46，53，61，78，84
62        15，27，34，41，53，68，76，82
63        15，28，34，41，53，66，72，87
64        15，28，34，41，57，62，76，83
65        16，21，35，42，58，63，77，84
66        16，22，37，41，53，65，78，84
67        16，22，37，41，54，68，75，83
68        16，23，31，47，55，68，72，84
69        16，23，31，48，54，62，77，85
70        16，23，31，48，55，62，74，87
71        16，23，35，47，51，64，72，88
72        16，23，35，48，51，64，72，87
73        16，23，37，42，54，68，71，85
74        16，23，37，42，58，65，71，84
75        16，23，37，44，51，68，72，85
76        16，24，31，45，58，62，77，83
77        16，24，32，48，55，67，71，83
78        16，24，37，41，53，65，72，88
79        16，24，37，41，58，62，75，83
80        16，28，32，44，51，67，75，83
81        17，21，33，48，56，64，72，85
82        17，22，34，41，58，65，73，86
83        17，22，36，43，51，64，78，85
84        17，23，31，46，58，65，72，84
85        17，23，38，42，55，61，76，84
86        17，24，32，45，58，61，73，86
87        17，24，32，48，56，61，73，85
88        17，25，33，41，56，68，72，84
89        18，22，34，41，57，65，73，86
90        18，22，35，43，51，67，74，86
91        18，23，31，46，52，65，77，84
92        18，24，31，43，56，62，77，85

aoe1981

　　这是我的中间分步直观演示图：
　　

aoe1981

　　下面是我的代码运行的效果：
　　
　　

aoe1981

　　好了，现在终于可以贴一下代码献丑了……

1. Option Explicit
   
2. Public Sub huanghou()
   
3. Dim x(1 To 8, 1 To 8), y(1 To 8, 1 To 8), i%, j%, m%, t!, n&
   
4. Dim k1%, k2%, k3%, k4%, k5%, k6%, k7%, k8%
   
5. Dim xx(1 To 8), yy(1 To 8), i1%, j1%, jg$, jgs%, szjg
   
6. ReDim szjg(1 To 1000, 1 To 2)
   
7. t = Timer
   
8. jgs = 0: n = 0
   
9. For i = 1 To 8
   
10.     For j = 1 To 8
    
11.         x(i, j) = i: y(i, j) = j
    
12. Next j, i
    
13. Range("j2:k" & Rows.Count).ClearContents
    
14. For k1 = 1 To 8
    
15.     xx(1) = x(1, k1): yy(1) = y(1, k1)
    
16.     For k2 = 1 To 8
    
17.         If k2 = k1 Then GoTo 100
    
18.         xx(2) = x(2, k2): yy(2) = y(2, k2)
    
19.         For k3 = 1 To 8
    
20.             If k3 = k2 Then GoTo 100
    
21.             xx(3) = x(3, k3): yy(3) = y(3, k3)
    
22.             For k4 = 1 To 8
    
23.                 If k4 = k3 Then GoTo 100
    
24.                 xx(4) = x(4, k4): yy(4) = y(4, k4)
    
25.                 For k5 = 1 To 8
    
26.                     If k5 = k4 Then GoTo 100
    
27.                     xx(5) = x(5, k5): yy(5) = y(5, k5)
    
28.                     For k6 = 1 To 8
    
29.                         If k6 = k5 Then GoTo 100
    
30.                         xx(6) = x(6, k6): yy(6) = y(6, k6)
    
31.                         For k7 = 1 To 8
    
32.                             If k7 = k6 Then GoTo 100
    
33.                             xx(7) = x(7, k7): yy(7) = y(7, k7)
    
34.                             For k8 = 1 To 8
    
35.                                 If k8 = k7 Then GoTo 100
    
36.                                 xx(8) = x(8, k8): yy(8) = y(8, k8)
    
37.                                 m = 0: jg = "": n = n + 1
    
38.                                 For i1 = 1 To 7
    
39.                                     For j1 = i1 + 1 To 8
    
40.                                         If xx(i1) = xx(j1) Then
    
41.                                             GoTo 100
    
42.                                         ElseIf yy(i1) = yy(j1) Then
    
43.                                             GoTo 100
    
44.                                         ElseIf Abs(xx(i1) - xx(j1)) = Abs(yy(i1) - yy(j1)) Then
    
45.                                             GoTo 100
    
46.                                         Else
    
47.                                             m = m + 1
    
48.                                         End If
    
49.                                 Next j1, i1
    
50.                                 If m = 28 Then
    
51.                                     'Range(Cells(1, 1), Cells(8, 8)).ClearContents
    
52.                                     For i = 1 To 8
    
53.                                         jg = jg & xx(i) & yy(i) & "，"
    
54.                                         'Cells(xx(i), yy(i)).Value = "●"
    
55.                                     Next i
    
56.                                     jg = Left(jg, Len(jg) - 1)
    
57.                                     jgs = jgs + 1
    
58.                                     szjg(jgs, 1) = jgs: szjg(jgs, 2) = jg
    
59.                                     'Cells(Rows.Count, 10).End(xlUp).Offset(1) = jgs
    
60.                                     'Cells(Rows.Count, 11).End(xlUp).Offset(1) = jg
    
61.                                     'MsgBox "这是第" & jgs & "种结果", , "友情提示"
    
62.                                 End If
    
63. 100:
    
64. Next k8, k7, k6, k5, k4, k3, k2, k1
    
65. Range("j2").Resize(UBound(szjg), 2) = szjg
    
66. MsgBox "共用时" & Format(Timer - t, "0.0000") & "秒，共比较" & n & "次，筛选出" & jgs & "种结果", , "友情提示"
    
67. End Sub
    
68. 
    

复制代码

　　其中，去掉注释部分后，计时基本就没意义了，但是可以动态看到中间过程的演示，不过，这个利用消息框实现的暂停效果不太好，前后92次，估计没几个人会挨得住，在这个程序运行展示中间结果需要暂停方面，还需要再改进，我一开始试了stop，但是很不好，此处求指教……

aoe1981

　　最后才是上附件，最不自量力的时刻到了……
　　 8皇后排列问题.rar (17.01 KB, 下载次数: 22)

2014-8-17 22:21 上传

点击文件名下载附件

　　前后比较6588344次，这个数字还是比较大……
　　最应该的比较次数应该是：

=FACT(8)

=40320

　　唉，还差远了，先抛一下砖，大家等着香川女侠为我们讲课吧……

aoe1981

　　哈哈，优化成功：
　　

aoe1981

　　传一个优化版附件：
　　 8皇后排列问题（优化版）.rar (14.74 KB, 下载次数: 35)

2014-8-17 22:38 上传

点击文件名下载附件

aoe1981

　　优化后的代码：

1. Option Explicit
   
2. Public Sub huanghou()
   
3. Dim x(1 To 8, 1 To 8), y(1 To 8, 1 To 8), i%, j%, m%, t!, n&
   
4. Dim k1%, k2%, k3%, k4%, k5%, k6%, k7%, k8%
   
5. Dim xx(1 To 8), yy(1 To 8), i1%, j1%, jg$, jgs%, szjg
   
6. ReDim szjg(1 To 1000, 1 To 2)
   
7. t = Timer
   
8. jgs = 0: n = 0
   
9. For i = 1 To 8
   
10.     For j = 1 To 8
    
11.         x(i, j) = i: y(i, j) = j
    
12. Next j, i
    
13. Range("j2:k" & Rows.Count).ClearContents
    
14. For k1 = 1 To 8
    
15.     xx(1) = x(1, k1): yy(1) = y(1, k1)
    
16.     For k2 = 1 To 8
    
17.         If k2 = k1 Then GoTo 100
    
18.         xx(2) = x(2, k2): yy(2) = y(2, k2)
    
19.         For k3 = 1 To 8
    
20.             If k3 = k2 Or k3 = k1 Then GoTo 100
    
21.             xx(3) = x(3, k3): yy(3) = y(3, k3)
    
22.             For k4 = 1 To 8
    
23.                 If k4 = k3 Or k4 = k2 Or k4 = k1 Then GoTo 100
    
24.                 xx(4) = x(4, k4): yy(4) = y(4, k4)
    
25.                 For k5 = 1 To 8
    
26.                     If k5 = k4 Or k5 = k3 Or k5 = k2 Or k5 = k1 Then GoTo 100
    
27.                     xx(5) = x(5, k5): yy(5) = y(5, k5)
    
28.                     For k6 = 1 To 8
    
29.                         If k6 = k5 Or k6 = k4 Or k6 = k3 Or k6 = k2 Or k6 = k1 Then GoTo 100
    
30.                         xx(6) = x(6, k6): yy(6) = y(6, k6)
    
31.                         For k7 = 1 To 8
    
32.                             If k7 = k6 Or k7 = k5 Or k7 = k4 Or k7 = k3 Or k7 = k2 Or k7 = k1 Then GoTo 100
    
33.                             xx(7) = x(7, k7): yy(7) = y(7, k7)
    
34.                             For k8 = 1 To 8
    
35.                                 If k8 = k7 Or k8 = k6 Or k8 = k5 Or k8 = k4 Or k8 = k3 Or k8 = k2 Or k8 = k1 Then GoTo 100
    
36.                                 xx(8) = x(8, k8): yy(8) = y(8, k8)
    
37.                                 m = 0: jg = "": n = n + 1
    
38.                                 For i1 = 1 To 7
    
39.                                     For j1 = i1 + 1 To 8
    
40.                                         If Abs(xx(i1) - xx(j1)) = Abs(yy(i1) - yy(j1)) Then
    
41.                                             GoTo 100
    
42.                                         Else
    
43.                                             m = m + 1
    
44.                                         End If
    
45.                                 Next j1, i1
    
46.                                 If m = 28 Then
    
47.                                     'Range(Cells(1, 1), Cells(8, 8)).ClearContents
    
48.                                     For i = 1 To 8
    
49.                                         jg = jg & xx(i) & yy(i) & "，"
    
50.                                         'Cells(xx(i), yy(i)).Value = "●"
    
51.                                     Next i
    
52.                                     jg = Left(jg, Len(jg) - 1)
    
53.                                     jgs = jgs + 1
    
54.                                     szjg(jgs, 1) = jgs: szjg(jgs, 2) = jg
    
55.                                     'Cells(Rows.Count, 10).End(xlUp).Offset(1) = jgs
    
56.                                     'Cells(Rows.Count, 11).End(xlUp).Offset(1) = jg
    
57.                                     'MsgBox "这是第" & jgs & "种结果", , "友情提示"
    
58.                                 End If
    
59. 100:
    
60. Next k8, k7, k6, k5, k4, k3, k2, k1
    
61. Range("j2").Resize(UBound(szjg), 2) = szjg
    
62. MsgBox "共用时" & Format(Timer - t, "0.0000") & "秒，共比较" & n & "次，筛选出" & jgs & "种结果", , "友情提示"
    
63. End Sub
    

复制代码

aoe1981

　　关于优化的感想：
　　本来以为像：If k8 = k7 Or k8 = k6 Or k8 = k5 Or k8 = k4 Or k8 = k3 Or k8 = k2 Or k8 = k1 Then GoTo 100这样的条件判断加在循环里面，虽然会减少循环次数，但是也会耗费时间，不喜欢采用，没想到用了以后，所得远远大于所失！
　　可能是因为，这些判断并没有身处循环的最核心（类似台风的风眼）的原因吧……

aoe1981

　　最后补充一点：
　　关于我的结果的表示：
　　我没有采用香川的自然数序号的办法：1～64
　　我采用的是直角坐标的办法：（行，列）或者（x,y）
　　例如：13应该是（1，3）表示第1行第3列……