第23講 数独を解くソフトVer.1の制作
第12話 予想だにしない結末
厳しい順に入力していって、Ver.1完成のはずだったのですが・・・・
Ver.1となるはずだったコード
Dim m(9, 9) As Byte, cn As Byte, onf(9, 9, 9) As Byte, ls(9, 9, 9) As Byte, lcn(9, 9) As Byte
Dim khs As Byte, yk(81) As Byte, xk(81) As Byte, tm As Byte
Private Sub CommandButton1_Click()
hj = Timer
tm = 0
cn = 0
dainyuu
kouzoukaiseki
'hyouji
zahyousakusei (0)
'hyouji2
f (0)
ow = Timer
Cells(6, 12) = "作成時間は"
Cells(6, 13) = ow - hj
Cells(6, 14) = "秒です。"
End Sub
Sub dainyuu()
Dim i As Byte, j As Byte
For i = 0 To 8
For j = 0 To 8
m(i, j) = Cells(3 + i, 2 + j)
Next
Next
For i = 0 To 8
For j = 0 To 8
If m(i, j) < 1 Then
m(i, j) = 0
End If
Next
Next
End Sub
Sub kouzoukaiseki()
Dim i As Byte, j As Byte, k As Byte, l As Byte, si As Byte, sj As Byte
khs = 0
For i = 0 To 8
For j = 0 To 8
If m(i, j) = 0 Then
yk(khs) = i
xk(khs) = j
khs = khs + 1
For k = 0 To 8
onf(i, j, k) = 1
Next
For k = 0 To 8
If m(i, k) > 0 Then onf(i, j, m(i, k) - 1) = 0
Next
For k = 0 To 8
If m(k, j) > 0 Then onf(i, j, m(k, j) - 1) = 0
Next
si = Int(i / 3)
sj = Int(j / 3)
For k = 0 To 2
For l = 0 To 2
If 3 * si + k <> i And 3 * sj + l <> j Then If m(3 * si + k, 3 * sj + l) > 0 Then onf(i, j, m(3 * si + k, 3 * sj + l) - 1) = 0
Next
Next
End If
lcn(i, j) = 0
For k = 0 To 8
If onf(i, j, k) = 1 Then
ls(i, j, lcn(i, j)) = k + 1
lcn(i, j) = lcn(i, j) + 1
End If
Next
Next
Next
End Sub
Sub hyouji()
Dim i As Byte, j As Byte, k As Byte
For i = 0 To 8
For j = 0 To 8
If m(i, j) = 0 Then Cells(13 + i, 2 + j) = lcn(i, j)
If m(i, j) > 0 Then Cells(13 + i, 2 + j) = "*"
Next
Next
End Sub
Sub zahyousakusei(g As Byte)
Dim i As Byte, j As Byte, w As Byte, min As Byte, ik As Byte, jk As Byte, k As Byte
min = 10
For i = g To khs - 1
If lcn(yk(i), xk(i)) < min Then
min = lcn(yk(i), xk(i))
ik = yk(i)
jk = xk(i)
k = i
End If
Next
w = yk(g)
yk(g) = ik
yk(k) = w
w = xk(g)
xk(g) = jk
xk(k) = w
If g + 1 < khs - 1 Then
zahyousakusei (g + 1)
If tm = 1 Then Exit Sub
Else
tm = 1
Exit Sub
End If
End Sub
Sub hyouji2()
Dim i As Byte, j As Byte, k As Byte
For i = 0 To khs - 1
Cells(13 + yk(i), 2 + xk(i)) = i
Next
End Sub
Sub f(g As Integer)
Dim x As Byte, y As Byte
Dim i, j, k, zy, zx As Byte
y = yk(g)
x = xk(g)
If m(x, y) > 0 Then
If g + 1 < 81 Then
f (g + 1)
Else
For j = 0 To 8
For k = 0 To 8
Cells(13 + j, 2 + k) = m(j, k)
Next
Next
cn = cn + 1
If cn = 1 Then Exit Sub
End If
Exit Sub
End If
Dim xa As Byte, ya As Byte, xs As Byte, ys As Byte, kk As Byte, kkk As Byte
xa = x Mod 3
ya = y Mod 3
xs = Int(x / 3)
ys = Int(y / 3)
kk = 9 * Rnd()
For i = 1 To 9
kkk = (kk + 4 * i) Mod 9 + 1
m(x, y) = kkk
For j = 0 To 8
If j <> x Then
If m(x, y) = m(j, y) Then GoTo tobi
End If
Next
For j = 0 To 8
If j <> y Then
If m(x, y) = m(x, j) Then GoTo tobi
End If
Next
For j = 0 To 2
For k = 0 To 2
If 3 * xs + j <> x And 3 * ys + k <> y Then
If m(x, y) = m(3 * xs + j, 3 * ys + k) Then GoTo tobi
End If
Next
Next
If g + 1 < 81 Then
f (g + 1)
Else
For j = 0 To 8
For k = 0 To 8
Cells(13 + j, 2 + k) = m(j, k)
Next
Next
cn = cn + 1
If cn = 1 Then Exit Sub
End If
If cn = 1 Then Exit Sub
tobi:
Next
m(x, y) = 0Private Sub CommandButton2_Click()
'Rows("3:11").Select
'Selection.ClearContents
Rows("13:32").Select
Selection.ClearContents
Cells(2, 1).Select
End Sub
次の2つダウンロード用ファイルを開いてください。
ダウンロード用参考ファイルVer.0時間計測版版
ダウンロード用参考ファイルVer.1もどき時間計測版版
2つは新次元難問数独自動生成ソフトVer.1
の作らせた100題の難問を解かせたときの1題あたりの解答時間を計測するものです。。
Ver.0ではという結果であり、
Ver.1もどきでは
残念ながらVer.0の圧倒です。
約4倍速いという結果です。
ウーン、これはどういうことでしょうか。
ランダムを使っているので、1,2題での逆転はあり得るでしょうが、
100題の平均です。
どうして、Ver.0の方が圧倒的に速いのでしょうか。
いろいろ調べましたが、原因は不明です。
例えば、問題構造解析とランク付けが重すぎて、逆転してしまう可能性を考えましたが、
両者にコンピュータが掛けている時間はせいぜい1題あたり平均で0.04秒程度にすぎません。
Ver.0の1題平均が約0.4秒ですから、
1/10遅れてのスタートですが、逆転は可能なはずです。
場合の数は、厳しい順に追う方が圧倒的に少ないのですから。
前に、ソフトを作ったときは条件が厳しい順にやった方が圧倒的に速かったのですが。
まさに、???です。
皆さんにお知恵をお借りしたいと思います。
とりあえず、ランク付け順に行くことは諦めて、
問題構造解析のもう一つの果実、リスト内容の把握の方を利用してVer.1の完成とします。
実際に、Ver.0よりかなり速くなりました。
1個あたりの平均が0.184523805975914秒です。4.4/1.8=約2.4倍です。
今回は失敗しましたが、ランク付けは改良して後のバージョンで使いますので、
残しておいてください。
第11話へ 第13話へ
VBA講義第1部へ
vc++講義へ
vb講義へ
VB講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
数学研究室に戻る