第７話 全セルリスト構造解析のプログラム例
プログラム全文
Dim mah(8, 8) As Byte, lst(8, 8, 8) As Byte, mx(8, 8) As Byte, h(8, 8, 8) As Byte
Private Sub CommandButton1_Click()
Dim i As Byte, j As Byte
dainyuu
syokika
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then
Call cellkaiseki1(i, j)
Call cellkaiseki2(i, j)
End If
Next
Next
hyouji
End Sub
Sub dainyuu()
Dim i As Byte, j As Byte
For i = 0 To 8
For j = 0 To 8
If Cells(4 + i, 2 + j) = "" Then mah(i, j) = 0 Else mah(i, j) = Cells(4 + i, 2 + j)
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
Cells(14 + i, 2 + j) = mah(i, j)
Next
Next
For i = 0 To 8
For j = 0 To 8
Cells(24 + 5 * i, 1 + 10 * j) = "セル"
Cells(24 + 5 * i, 2 + 10 * j) = i
Cells(24 + 5 * i, 3 + 10 * j) = j
Cells(24 + 5 * i, 4 + 10 * j) = "のリスト"
For k = 0 To 8
Cells(25 + 5 * i, 1 + 10 * j + k) = lst(i, j, k)
Next
Cells(26 + 5 * i, 1 + 10 * j) = "セル"
Cells(26 + 5 * i, 2 + 10 * j) = i
Cells(26 + 5 * i, 3 + 10 * j) = j
Cells(26 + 5 * i, 4 + 10 * j) = "のリスト数"
Cells(27 + 5 * i, 1 + 10 * j) = mx(i, j)
Next
Next
End Sub
Sub syokika()
Dim i As Byte, ja As Byte, k As Byte
For i = 0 To 8
For j = 0 To 8
For k = 0 To 8
h(i, j, k) = 1
lst(i, j, k) = k + 1
Next
Next
Next
End Sub
Sub cellkaiseki1(i As Byte, j As Byte)
Dim k As Byte, l As Byte
For k = 0 To 8
If mah(i, k) > 0 Then h(i, j, mah(i, k) - 1) = 0
Next
For k = 0 To 8
If mah(k, j) > 0 Then h(i, j, mah(k, j) - 1) = 0
Next
For k = 0 To 2
For l = 0 To 2
If 3 * Int(i / 3) + k <> i And 3 * Int(j / 3) + l <> j Then
If mah(3 * Int(i / 3) + k, 3 * Int(j / 3) + l) > 0 Then h(i, j, mah(3 * Int(i / 3) + k, 3 * Int(j / 3) + l) - 1) = 0
End If
Next
Next （2014/12/07訂正）
End Sub
Sub cellkaiseki2(i As Byte, j As Byte)
Dim k As Byte, w As Byte
w = 0
For k = 0 To 8
If h(i, j, k) = 1 Then
lst(i, j, w) = k + 1
w = w + 1
End If
Next
mx(i, j) = w
For k = 0 To 8
If h(i, j, k) = 0 Then
lst(i, j, w) = k + 1
w = w + 1
End If
Next
End Sub
Private Sub CommandButton2_Click()
Rows("14:200").Select
Selection.ClearContents
Range("M5", "V9").Select
Selection.ClearContents
Cells(2, 1).Select
End Sub
参考ファイル５
さて、全セルのリスト構造解析が済みましたので、
これに基づいていよいよ数独をコンピュータに解かせます。
ただし、プログラムを複雑にしすぎないため、
プログラムがセルに数字を入れることによってリスト構造が変化することは、
考慮に入れないことにします。
プログラムがセルに数字を入れたことによるリスト構造変化を組み込むのは、
次の講の課題とします。
第13講 プロシージャの再帰的使用による数独解答自動生成
第５話 数独解答自動生成ソフトコード例
を参考に考えて頂きたいと思いますが、
いきなりだと難しいと思いますのでヒントとして、
プログラムの1部のコードを載せておきます。
Dim mah(8, 8) As Byte, lst(8, 8, 8) As Byte, mx(8, 8) As Byte, h(8, 8, 8) As Byte, cn As Byte
Private Sub CommandButton1_Click()
Dim i As Byte, j As Byte, hajime As Variant, owari As Variant
hajime = Timer
dainyuu
syokika
For i = 0 To 8
For j = 0 To 8
If mah(i, j) = 0 Then
Call cellkaiseki1(i, j)
Call cellkaiseki2(i, j)
End If
Next
Next
f (0)
owari = Timer
Cells(7, 13) = "解くのにかかった時間は"
Cells(8, 13) = owari - hajime
Cells(9, 13) = "秒です。"
End Sub
Sub hyouji()
Dim i As Byte, j As Byte, k As Byte
For i = 0 To 8
For j = 0 To 8
Cells(14 + i, 2 + j) = mah(i, j)
Next
Next
End Sub
Sub syokika()
Dim i As Byte, ja As Byte, k As Byte
cn = 0
For i = 0 To 8
For j = 0 To 8
For k = 0 To 8
h(i, j, k) = 1
lst(i, j, k) = k + 1
Next
Next
Next
End Sub
Sub f(g As Byte)
Dim i As Byte, j As Byte, k As Byte
Dim y As Byte, x As Byte, h As Byte
y = Int(g / 9)
x = g Mod 9
If mah(y, x) > 0 Then
If g + 1 < 81 Then
f (g + 1)
If cn = 1 Then Exit Sub
Else
cn = cn + 1
hyouji
End If
End If
h = 0
If mah(y, x) = 0 Then
For i = 0 To mx(y, x) - 1
mah(y, x) = lst(y, x, i)
h = 1
For j = 0 To 8
If j <> x Then
If mah(y, x) = mah(y, j) Then GoTo tobi
End If
Next
・
・
・
If g + 1 < 81 Then
f (g + 1)
If cn = 1 Then Exit Sub
Else
cn = cn + 1
hyouji
End If
tobi:
Next
End If
If h = 1 Then mah(y, x) = 0
End Sub
実行画面
