回溯法解数独，平均用时<0.2秒

香川群子 · 发表于 2013-10-22 21:12

不过遗憾的是，有时候这么做反而速度更慢……毕竟变化次数和剩余数最少并非绝对的正相关。

但大部分情况下可以得到好的表现。

yangyangzhifeng · 发表于 2013-10-23 07:50

像下面这个题，就退化太多了
未命名.png

香川群子 · 发表于 2013-10-23 08:26

yangyangzhifeng 发表于 2013-10-23 07:50
像下面这个题，就退化太多了

不过，这样电脑随机生成的题目，随意性太大，本来就不适合用来做题目给人做。

→ 这样的题目，人脑无解。因为基本没有可以心算就可以确定的数字。

香川群子 · 发表于 2013-10-23 08:52

其实，和直接按从左到右、从上到下顺序来计算的方法，本质上计算时的算法是一样的，
不同的只是对空白格子的试算时的顺序不同而已……

因此，直接按从左到右、从上到下顺序来计算时，也存在着需要大量耗费时间甚至死机的题目。

香川群子 · 发表于 2013-10-23 08:55

我现在能想到的一个改进是：

不是按照剩余个数排序，而是按照每个空格的实际候选数的多少，从小到大来排序。

呵呵，这个应该是真正合理的方法，用空把代码写出来再比较一下。

香川群子 · 发表于 2013-10-23 09:02

下面这个电脑随机题目，是按从左到右顺序测试时退化比较严重的→ 用你的代码大约 1.5秒

而顺序改进代码却只要 0.09秒

yangyangzhifeng · 发表于 2013-10-23 09:58

香川群子发表于 2013-10-23 08:55
我现在能想到的一个改进是：

不是按照剩余个数排序，而是按照每个空格的实际候选数的多少，从小到大来排 ...

我也尝试了，按实际候选数的多少排序写的代码，对有些题，退化比你写的那个还严重

lee1892 · 发表于 2013-10-23 10:24

你们要是喜欢玩数独，建议你们自己写一段数独题的读写代码，方便交流
通行的办法是用一个81位长的字符串来表示一个数独题目，空格为0，先行后列，比如26楼的那个就可以表示为：
“000 000 007 470 650 120 000 070 006 500 700 000 104 900 000 007 000 600 340 017 209 902 300 780 700 000 003”
上面空格为了方便阅读，实际不需要。

yangyangzhifeng · 发表于 2013-10-23 11:35

按初始可选数排序代码如下：

Sub sudoku2()
Dim ar, i&, j&, jg&(1 To 81), x&, t&, tt, jwz&(1 To 81), jcs(1 To 81), y&, xx&(1 To 9), k&, b&
Dim f_g&(1 To 9, 1 To 9), f_h&(1 To 9, 1 To 9), f_l&(1 To 9, 1 To 9)
Dim g&(1 To 81), h&(1 To 81), l&(1 To 81)
tt = Timer
ar = Sheet1.[b2].Resize(9, 9)
For i = 1 To 81
jcs(i) = xx
Next
For i = 1 To 9
For j = 1 To 9
x = x + 1
h(x) = i: l(x) = j
g(x) = ((i - 1) \ 3) * 3 + (j - 1) \ 3 + 1
jg(x) = ar(i, j)
If jg(x) > 0 Then
If f_g(g(x), jg(x)) + f_h(h(x), jg(x)) + f_l(l(x), jg(x)) > 0 Then MsgBox "无解": Exit Sub
f_g(g(x), jg(x)) = 1
f_h(h(x), jg(x)) = 1
f_l(l(x), jg(x)) = 1
Else
y = y + 1
jwz(y) = x
For k = 1 To 9
If ar(i, k) Then jcs(x)(ar(i, k)) = 1
If ar(k, j) Then jcs(x)(ar(k, j)) = 1
Next
For b = ((i - 1) \ 3) * 3 + 1 To ((i - 1) \ 3) * 3 + 3
For k = ((j - 1) \ 3) * 3 + 1 To ((j - 1) \ 3) * 3 + 3
If ar(b, k) Then jcs(x)(ar(b, k)) = 1
Next
Next
k = 0
For b = 1 To 9
k = k + jcs(x)(b)
Next
jcs(y) = k
End If
Next
Next
For i = 1 To y - 1
For j = y To i + 1 Step -1
If jcs(j) > jcs(j - 1) Then
k = jcs(j): jcs(j) = jcs(j - 1): jcs(j - 1) = k
k = jwz(j): jwz(j) = jwz(j - 1): jwz(j - 1) = k
End If
Next
Next
j = 1: t = 1
Do
If j > y Then Exit Do
x = jwz(j)
For i = jg(x) + 1 To 9
If f_g(g(x), i) = 0 Then
If f_h(h(x), i) = 0 Then
If f_l(l(x), i) = 0 Then
jg(x) = i: t = 1
f_g(g(x), jg(x)) = 1
f_h(h(x), jg(x)) = 1
f_l(l(x), jg(x)) = 1
Exit For
End If
End If
End If
Next
If i > 9 Then
t = -1
jg(x) = 0
If j > 1 Then
x = jwz(j - 1)
f_g(g(x), jg(x)) = 0
f_h(h(x), jg(x)) = 0
f_l(l(x), jg(x)) = 0
Else
MsgBox "无解": Exit Sub
End If
End If
j = j + t
Loop
For i = 1 To 81
ar(h(i), l(i)) = jg(i)
Next
Sheet1.[b12].Resize(9, 9) = ar
MsgBox Format(Timer - tt, "0.000s ")
Sheet1.[b12].Resize(9, 9).Interior.ColorIndex = -4142
Sheet1.[b2].Resize(9, 9).SpecialCells(xlCellTypeConstants, 1).Offset(10).Interior.Color = vbRed
End Sub

复制代码

对下面这道题效果明显

*********
*21*4****
**4**6***
5**6*3***
*****8***
**9***2*1
8******6*
****2*4**
*******3*

香川群子 · 发表于 2013-10-23 14:09

lee1892 发表于 2013-10-23 10:24
你们要是喜欢玩数独，建议你们自己写一段数独题的读写代码，方便交流
通行的办法是用一个81位长的字符串来 ...

呵呵，我们现在的代码中就是使用sj(1 to 81)来记录和处理数据的。

比
for i=1 to 9
for j = 1 to 9

next
next

方式效率高。

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

[分享] 回溯法解数独，平均用时<0.2秒