第４講 数独を解くソフトの開発（１）
第10話 数独を解くソフトVer.3
Ver.3のコード例
Dim n As Byte, m(8, 8) As Byte, cn As Integer, hnt As Byte, iz(80) As Byte, jz(80) As Byte, cm(8, 8) As Byte
'nは数独の一辺、x(15)は数独を収納する配列、cnは数独総数をカウント、hntはヒント数
'iz(80)はｙ座標を収納する配列、jz(80)はｘ座標を収納する配列
'cm(i, j)はm(i, j)のバックアップ配列
Dim ironuri(8, 8, 8) As Byte, rlst(8, 8, 8) As Byte, mx(8, 8) As Byte
'ironuri(i, j, k)は色塗り 0:は白 1:は色あり rlst(8, 8, 8)は候補数字を収納する配列、mx(8, 8)は候補数次数を収める配列
Private Sub CommandButton1_Click()
CommandButton2_Click
n = 9
hj = Timer 'はじめの時間取得
' Randomize (Timer) 'シード値を時間から取得
dainyu 'シートのB4からJ12のセルからm(i, j)に代入することが任務
f (0) '数独作成プロシージャ
ow = Timer
hyouji
' hyoujirlst 'リスト構造解析の表示＝各セルの候補数字の表示
' hyouji1 '候補数字数の表示
Cells(4, 12) = "問題を解くのにかかった時間は"
Cells(5, 12) = ow - hj
Cells(6, 12) = "秒です。"
If cn = 1 And seigohantei = 1 Then Cells(7, 12) = "正しい解答です。" Else Cells(7, 12) = "誤った解答です。"
End Sub
Function seigohantei() '出来た数独が適正であるか調べるプロシージャ
Dim i As Byte, j As Byte, a(8) As Byte
For i = 0 To n - 1 '問題の数字と解答の同位置の数字が一致しているか調べている
For j = 0 To n - 1
If Cells(4 + i, 2 + j) > 0 Then
If Cells(4 + i, 2 + j) <> Cells(14 + i, 2 + j) Then
seigohantei = 0
Exit Function
End If
End If
If Cells(14 + i, 2 + j) = "" Then '解答に空欄がないかを調べている
seigohantei = 0
Exit Function
End If
Next
Next
For i = 0 To n - 1 '行に１から９までの数字がひとつずつ並んでいるかをチェック
For j = 0 To n - 1
a(j) = 0
Next
For j = 0 To n - 1
a(Cells(14 + i, 2 + j) - 1) = 1
Next
For j = 0 To n - 1
If a(j) = 0 Then
seigohantei = 0
Exit Function
End If
Next
Next
For i = 0 To n - 1 '列に１から９までの数字がひとつずつ並んでいるかをチェック
For j = 0 To n - 1
a(j) = 0
Next
For j = 0 To n - 1
a(Cells(14 + j, 2 + i) - 1) = 1
Next
For j = 0 To n - 1
If a(j) = 0 Then
seigohantei = 0
Exit Function
End If
Next
Next
Dim y As Byte, x As Byte
For i = 0 To n - 1 'ブロックに１から９までの数字がひとつずつ並んでいるかをチェック
For j = 0 To n - 1
a(j) = 0
Next
For j = 0 To n - 1
y = 3 * Int(i / 3) + Int(j / 3)
x = 3 * (i Mod 3) + (j Mod 3)
a(Cells(14 + y, 2 + x) - 1) = 1
Next
For j = 0 To n - 1
If a(j) = 0 Then
seigohantei = 0
Exit Function
End If
Next
Next
seigohantei = 1
End Function
Sub dainyu()
Dim i As Byte, j As Byte, k As Byte, w As Byte, y As Byte, x As Byte
For i = 0 To n - 1 '初期化処理、m(i, j)とironuri(i, j, k)をすべて0に初期化
For j = 0 To n - 1
m(i, j) = 0
For k = 0 To n - 1
ironuri(i, j, k) = 0
Next
Next
Next
hnt = 0
For i = 0 To n - 1
For j = 0 To n - 1
If Cells(4 + i, 2 + j) > 0 Then
m(i, j) = Cells(4 + i, 2 + j)
For k = 0 To n - 1 'セルリスト構造解析のための色塗り
If m(i, k) = 0 Then
ironuri(i, k, m(i, j) - 1) = 1 '行についての色塗り
End If
If m(k, j) = 0 Then
ironuri(k, j, m(i, j) - 1) = 1 '列についての色塗り
End If
y = 3 * Int(i / 3) + Int(k / 3)
x = 3 * Int(j / 3) + (k Mod 3)
If y <> i And x <> j Then
If m(y, x) = 0 Then
ironuri(y, x, m(i, j) - 1) = 1 'ブロックについての色塗り
End If
End If
Next
hnt = hnt + 1
Else
m(i, j) = 0
End If
Next
Next
For i = 0 To n - 1 '全体構造解析＝すべてのセルについてセルリスト構造解析をする
For j = 0 To n - 1
If m(i, j) = 0 Then
kyokusyokaiseki i, j '座標(i, j)について「セルリスト構造解析＝局所解析」
End If
Next
Next
cn = 0
End Sub
Sub kyokusyokaiseki(y As Byte, x As Byte) 'セルリスト構造解析、解析場所を1つのセルに限定しているので局所解析と呼ぶ
Dim i As Byte, w As Byte
w = 0
For i = 0 To n - 1
If ironuri(y, x, i) = 0 Then
rlst(y, x, w) = i + 1
w = w + 1
End If
Next
mx(y, x) = w
End Sub
Sub nyuryokujyun(g As Byte) '最も効率的に数独を作成させるための座標作り＝数字候補数が最も少ないセルを座標にする
Dim i As Byte, j As Byte, mn As Byte, ik As Byte, jk As Byte
mn = 100
For i = 0 To 8
For j = 0 To 8
If m(i, j) = 0 Then
If mx(i, j) < mn Then
mn = mx(i, j)
ik = i
jk = j
End If
End If
Next
Next
iz(g) = ik
jz(g) = jk
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, k As Byte, h As Byte, w As Byte
Dim y As Byte, x As Byte, yy As Byte, xx As Byte
Dim hg(8) As Byte, hr(8) As Byte, hb(8) As Byte 'それぞれ行、列、ブロックについて色を塗った場所を記録するための配列
nyuryokujyun (g)
y = iz(g)
x = jz(g)
kyokusyokaiseki y, x '局所解析
If mx(y, x) = 0 Then Exit Sub '破綻処理、破綻した場合過去の入れ方が悪いので、過去に戻ってやり直し
For i = 0 To mx(y, x) - 1
m(y, x) = rlst(y, x, i) 'セルの候補数字のみを対象にする
For j = 0 To n - 1
hg(j) = 0
hr(j) = 0
hb(j) = 0
Next
For j = 0 To n - 1
If m(y, j) = 0 Then
If ironuri(y, j, m(y, x) - 1) = 0 Then
ironuri(y, j, m(y, x) - 1) = 1 'm(y, x)の入力によって影響を受けた行のセルの色塗り
hg(j) = 1 '色を塗った行位置を記録
End If
End If
If m(j, x) = 0 Then
If ironuri(j, x, m(y, x) - 1) = 0 Then
ironuri(j, x, m(y, x) - 1) = 1 'm(y, x)の入力によって影響を受けた列のセルの色塗り
hr(j) = 1 '色を塗った列位置を記録
End If
End If
yy = 3 * Int(y / 3) + Int(j / 3)
xx = 3 * Int(x / 3) + (j Mod 3)
If yy <> y And xx <> x Then
If m(yy, xx) = 0 Then
If ironuri(yy, xx, m(y, x) - 1) = 0 Then
ironuri(yy, xx, m(y, x) - 1) = 1 'm(y, x)の入力によって影響を受けたブロックのセルの色塗り
hb(j) = 1 '色を塗ったブロック位置を記録
End If
End If
End If
Next
If g + 1 < n * n - hnt Then
f (g + 1) '行・列・ブロックの重複がなく、g + 1がn * n - hnt以下のときに、次のセル番号の世界に飛ぶ
If cn = 2 Then Exit Sub 'cn = 2となっている理由は別解がないか探索させるため
Else
cn = cn + 1 '数独総数カウント
If cn = 1 Then
For j = 0 To n - 1 '別解がないか探索させている間にm(i ,j)は壊されてしまうためにバックアップをとっている。
For k = 0 To n - 1
cm(j, k) = m(j, k)
Next
Next
End If
If cn = 2 Then Exit Sub 'cn = 2となっている理由は別解がないか探索させるため
End If
For j = 0 To n - 1
If hg(j) = 1 Then
ironuri(y, j, m(y, x) - 1) = 0 'm(y, x)に値を入れ直すので、行で影響を受けたセルについて色を白に復元
End If
If hr(j) = 1 Then
ironuri(j, x, m(y, x) - 1) = 0 'm(y, x)に値を入れ直すので、列で影響を受けたセルについて色を白に復元
End If
If hb(j) = 1 Then
yy = 3 * Int(y / 3) + Int(j / 3)
xx = 3 * Int(x / 3) + (j Mod 3)
ironuri(yy, xx, m(y, x) - 1) = 0 'm(y, x)に値を入れ直すので、ブロックで影響を受けたセルについて色を白に復元
End If
Next
Next
m(y, x) = 0
End Sub
Sub hyouji() '解答表示プロシージャ
Dim i As Byte, j As Byte
For i = 0 To n - 1
For j = 0 To n - 1
If cm(i, j) > 0 Then Cells(14 + i, 2 + j) = cm(i, j)
Next
Next
End Sub
Sub hyoujirlst() '全セルの候補数字を表示するプロシージャ
Dim i As Byte, j As Byte, k As Byte
For i = 0 To n - 1
For j = 0 To n - 1
If m(i, j) = 0 Then
If mx(i, j) > 0 Then
For k = 0 To mx(i, j) - 1
Cells(4 + i, 12 + 9 * j + k) = rlst(i, j, k)
Next
End If
End If
Next
Next
End Sub
Sub hyouji1() '全セルの数字候補数を表示するプロシージャ
Dim i As Byte, j As Byte
For i = 0 To n - 1
For j = 0 To n - 1
If Cells(4 + i, 2 + j) > 0 Then Cells(14 + i, 2 + j) = "＊" Else Cells(14 + i, 2 + j) = mx(i, j)
Next
Next
End Sub
Private Sub CommandButton2_Click()
Rows("14:22").Select
Selection.ClearContents
Range("L4:L7").Select
Selection.ClearContents
Columns("L:cp").Select
Selection.ClearContents
Cells(1, 1).Select
End Sub
参考ダウンロード添付ファイル
Ver.3はVer.2と比較して解く速度は３５倍加、Ver.1と比べて４２倍加しています。
Ver.3を参考にして、
第２講と第３講で開発したヒント数０数独の解答自動生成ソフトも改良できます。
これは第６講辺りの課題になることを予告して、
第４講を終わりにします。
第５講では、問題をいかに作るかを考えます。
そして、数独を解くソフトVer.3で解かせます。
唯一解の問題であるかを確認させます。
