第3講 試行錯誤法でヒント数0数独の解答を作る(2)
第6話 速度比較プログラム
オレンジを対象から外すバージョン
Dim n As Byte, m(8, 8) As Byte, cn As Integer
Private Sub CommandButton1_Click()
CommandButton2_Click
n = 9
cn = 0
hj = Timer
f (0) 'n次順列作成プロシージャ
Cells(3, 2) = "1万個生成するのにかかった時間は"
Cells(3, 12) = Timer - hj
Cells(3, 13) = "秒です。"
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, h As Byte, a As Integer, s As Integer, w As Byte
Dim y As Byte, x As Byte, yy As Byte, xx As Byte
y = Int(g / n)
x = g Mod n
a = cn Mod 10
s = Int(cn / 10)
For i = 0 To n - 1
m(y, x) = i + 1
h = 1
If x > 0 Then
For j = 0 To x - 1
If m(y, x) = m(y, j) Then
h = 0
Exit For
End If
Next
End If
If h = 1 And y > 0 Then
For j = 0 To y - 1
If m(y, x) = m(j, x) Then
h = 0
Exit For
End If
Next
End If
If h = 1 And x > 0 Or y > 0 Then
For j = 0 To n - 1
xx = 3 * Int(x / 3) + (j Mod 3)
yy = 3 * Int(y / 3) + Int(j / 3)
If x = xx And y = yy Then Exit For
If x <> xx And y <> yy Then
If m(yy, xx) = m(y, x) Then
h = 0
Exit For
End If
End If
Next
End If
If h = 1 Then
If g + 1 < n * n Then
f (g + 1)
If cn = 10 Then Exit Sub
Else
For j = 0 To n * n - 1
Cells(4 + Int(j / n) + (n + 1) * s, 2 + (j Mod n) + (n + 1) * a) = m(Int(j / n), (j Mod n))
Next
cn = cn + 1
If cn = 10 Then Exit Sub
End If
End If
Next
End Sub
Private Sub CommandButton2_Click()
Rows("3").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
オレンジを対象とするバージョン
Dim n As Byte, m(8, 8) As Byte, cn As Integer
Private Sub CommandButton1_Click()
CommandButton2_Click
n = 9
cn = 0
hj = Timer
f (0) 'n次順列作成プロシージャ
Cells(3, 2) = "1万個生成するのにかかった時間は"
Cells(3, 12) = Timer - hj
Cells(3, 13) = "秒です。"
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, h As Byte, a As Integer, s As Integer, w As Byte
Dim y As Byte, x As Byte, yy As Byte, xx As Byte
y = Int(g / n)
x = g Mod n
a = cn Mod 10
s = Int(cn / 10)
For i = 0 To n - 1
m(y, x) = i + 1
h = 1
If x > 0 Then
For j = 0 To x - 1
If m(y, x) = m(y, j) Then
h = 0
Exit For
End If
Next
End If
If h = 1 And y > 0 Then
For j = 0 To y - 1
If m(y, x) = m(j, x) Then
h = 0
Exit For
End If
Next
End If
If h = 1 And y > 0 Then
For j = 0 To n - 1
xx = 3 * Int(x / 3) + (j Mod 3)
yy = 3 * Int(y / 3) + Int(j / 3)
If x = xx And y = yy Then Exit For
If x <> xx Or y <> yy Then
If m(yy, xx) = m(y, x) Then
h = 0
Exit For
End If
End If
Next
End If
If h = 1 Then
If g + 1 < n * n Then
f (g + 1)
If cn = 10000 Then Exit Sub
Else
' For j = 0 To n * n - 1
' Cells(4 + Int(j / n) + (n + 1) * s, 2 + (j Mod n) + (n + 1) * a) = m(Int(j / n), (j Mod n))
' Next
cn = cn + 1
If cn = 10000 Then Exit Sub
End If
End If
Next
End Sub
Private Sub CommandButton2_Click()
Rows("3").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
オレンジを対象から外すバージョン
オレンジと対象とするバージョン
ほんのわずかですが、やはり対象から外した方が速いようですね。
したがって、以降は対象から外すバージョンで進めます。
ブロック内の過去(セル番号が自分より若い)セルについて、
If x <> xx Or y <> yy Then
は、自分以外をすべて検査対象にするのに対して、
If x <> xx And y <> yy Then
は、自分以外かつ同じ行にも同じ列にもないセルを検査対象にしています。
第3講最後の課題です。第5話で作った
では、実は使いものになりません。
解答の配置が悪すぎて、
ここからいかように数字を消して空欄を作っていっても、
良問は作れないのです。
配置が悪いというのは、規則的すぎるのです。
上には1個しか表示させていませんが、
おそらく1万個生成させたとしても、
その中に使えるものは1つもないでしょう。
何が問題なのでしょうか。
それはランダム性がないということです。
順に作っていることが問題なのです。
どのセルについても、、
1,2,3,4,5,6,7,8,9
の順であらゆる場合を調べています。
これを例えば、セルによって
4,5,6,7,8,9,1,2,3
や
7,8,9,1,2,3,4,5,6
とはじまりを変えればより自然な配置になる可能性があります。
つまり、セルごとに始まりをランダムに変えるのです。
でも本当は、
3,9,4,1,2,5,8,7,6
始まりだけでなく、内部の順番も変更した方がよいかもしれませんね。
どちらの方がよい配置が出来るのかは、
やはり実験しなければわかりません。
4,5,6,7,8,9,1,2,3
7,8,9,1,2,3,4,5,6
などは比較的に簡単にできるのに対して、
3,9,4,1,2,5,8,7,6
を考えるのは難度が高いですから、
とりあえずは始まりだけランダムに変えることにしましょう。
問題は、どうしたら9の後に1から始まるようにできるかです。
皆さん考えてください。
尚、毎回同じ解答が出来ないように、シード値は時間から取得することにしましょう。
シード値が同じだとエクセルを起動してから、毎回同じ順番で同じ解答が出来てしまいますね。
これは、
昨日起動してから1回目に作った解答と今日起動してから1回目に作った解答
昨日起動してから2回目に作った解答と今日起動してから2回目に作った解答
昨日起動してから3回目に作った解答と今日起動してから3回目に作った解答
・
・
・
が同じになってしまうことを指しています。
セルごとに始まりをランダムに変えることが出来ると、
のようにとても自然な配置になります。
皆さんは初心者の域を卒業した方ですから、
シード値を時間から取得しているので、
私と同じものは決して出来ないということはおわかりですよね。
でも、0.001%程度なら同じになる可能性はあるのでは?
そう考える方はかなり賢い方ですが、
おそらく宇宙時間(宇宙の始まりから終わりまでの時間)試し続けても、
1個たりとも同じものは出来ないと思います。