第５話 相補確定解析例
コード変更部分
Sub sds(g As Byte, mok As Byte) '数独作成プロシージャ
If mok = 1 Then If mx(y(g), x(g)) > 0 Then Exit Sub
'確定法で問題を解かせるための命令文
'リストは１個しかない場合のみに以降を続ける。
'リストが２個以上ある場合には強制的に前に戻させる。
'試行錯誤はさせないので、g = hintosu まで戻り、
'更に、CommandButton1_ClickのDo文に戻り、
'次の問題を作るようになっている。
'以下同じことを繰り返せば、確定法で解ける問題が必然的に出来る！
'確定法で解く＝試行錯誤をしないので、復元に関する規定は一切不要になるために、
'復元に関する命令文はすべて注釈文にしてある。
・
If g + 1 < n2 Then
u = nck(g + 1, mok)
If u = 1 Then
Call sds(g + 1, mok)
End If
'仮定法を捨て去ったので復元が不要になった！！！
' If rh(g + 1) = 1 Then
' mx(y(g + 1), x(g + 1)) = cmx(g + 1, y(g + 1), x(g + 1))
' For j = 0 To n_1
' rlst(y(g + 1), x(g + 1), j) = crlst(g + 1, y(g + 1), x(g + 1), j)
' Next
' For j = 0 To n_1
' kh(y(g + 1), x(g + 1), j) = ckh(g + 1, y(g + 1), x(g + 1), j)
' Next
' End If
' If mok = 1 Then
' If sh(g + 1) = 1 Then
' For j = 0 To sc(g + 1) - 1
' If hth(g + 1, sy(g + 1, j), sx(g + 1, j)) = 1 Then
' mx(sy(g + 1, j), sx(g + 1, j)) = cmx(g + 1, sy(g + 1, j), sx(g + 1, j))
' For k = 0 To n_1
' rlst(sy(g + 1, j), sx(g + 1, j), k) = crlst(g + 1, sy(g + 1, j), sx(g + 1, j), k)
' Next
' For k = 0 To n_1
' kh(sy(g + 1, j), sx(g + 1, j), k) = ckh(g + 1, sy(g + 1, j), sx(g + 1, j), k)
' Next
' End If
' Next
' End If
' End If
・
End Sub
Function rhk(g As Byte) 'ライン排除確定解析＋相補確定解析プロシージャ
・
' For i = 0 To n_1
' For j = 0 To n_1
' hth(g, i, j) = 0
' Next
' Next
' rh(g) = 0
' sh(g) = 0
'以下各数字に対応する行におけるライン排除確定があるかを調べるための手順
・
If w = 1 Then '以下ライン排除確定解析
For k = 0 To mx(j, xs(0))
If rlst(j, xs(0), k) = i + 1 Then
For l = 0 To n_1 '以下ライン排除確定による破綻解析
If l <> xs(0) And p(j, l) = 0 Then
If mx(j, l) = 0 And rlst(j, l, 0) = i + 1 Then
' rh(g) = 0
rhk = 0
Exit Function
End If
End If
Next
For l = 0 To n_1
If l <> j And p(l, xs(0)) = 0 Then
If mx(l, xs(0)) = 0 And rlst(l, xs(0), 0) = i + 1 Then
' rh(g) = 0
rhk = 0
Exit Function
End If
End If
Next
ybs = rn * Int(j / rn)
xbs = rn * Int(xs(0) / rn)
For l = 0 To n_1
ls = Int(l / rn)
la = l Mod rn
If ybs + ls <> j And xbs + la <> xs(0) And p(ybs + ls, xbs + la) = 0 Then
If mx(ybs + ls, xbs + la) = 0 And rlst(ybs + ls, xbs + la, 0) = i + 1 Then
' rh(g) = 0
rhk = 0
Exit Function
End If
End If
Next '以上ライン排除確定による破綻解析
y(g) = j
x(g) = xs(0)
' cmx(g, y(g), x(g)) = mx(y(g), x(g))
' For l = 0 To n_1
' crlst(g, y(g), x(g), l) = rlst(y(g), x(g), l)
' Next
' For l = 0 To n_1
' ckh(g, y(g), x(g), l) = kh(y(g), x(g), l)
' Next
rlst(y(g), x(g), 0) = i + 1
rlst(y(g), x(g), 1) = k + 1
mx(y(g), x(g)) = 0
kh(y(g), x(g), i) = 0
' rh(g) = 1
rhk = 1
Exit Function
End If
Next
End If '以上ライン排除確定解析
If w = 2 Then '以下相補確定解析のための手続き
For k = i + 1 To n_1
w = 0
For l = 0 To n_1
If p(j, l) = 0 Then
If kh(j, l, k) = 1 Then
xs1(w) = l
w = w + 1
End If
End If
Next
If w = 2 And xs(0) = xs1(0) And xs(1) = xs1(1) Then '以下相補確定
If hth(g, j, xs(0)) = 0 Then
sx(g, sc(g)) = xs(0)
sy(g, sc(g)) = j
' cmx(g, sy(g, sc(g)), sx(g, sc(g))) = mx(sy(g, sc(g)), sx(g, sc(g)))
' For l = 0 To n_1
' crlst(g, sy(g, sc(g)), sx(g, sc(g)), l) = rlst(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
' For l = 0 To n_1
' ckh(g, sy(g, sc(g)), sx(g, sc(g)), l) = kh(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
mx(sy(g, sc(g)), sx(g, sc(g))) = 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 0) = i + 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 1) = k + 1
' hth(g, sy(g, sc(g)), sx(g, sc(g))) = 1
sc(g) = sc(g) + 1
End If
If hth(g, j, xs(1)) = 0 Then
sx(g, sc(g)) = xs(1)
sy(g, sc(g)) = j
' cmx(g, sy(g, sc(g)), sx(g, sc(g))) = mx(sy(g, sc(g)), sx(g, sc(g)))
' For l = 0 To n_1
' crlst(g, sy(g, sc(g)), sx(g, sc(g)), l) = rlst(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
' For l = 0 To n_1
' ckh(g, sy(g, sc(g)), sx(g, sc(g)), l) = kh(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
mx(sy(g, sc(g)), sx(g, sc(g))) = 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 0) = i + 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 1) = k + 1
' hth(g, sy(g, sc(g)), sx(g, sc(g))) = 1
sc(g) = sc(g) + 1
End If
' sh(g) = 1
Exit Function
End If '以下相補確定
Next
End If '以上相補確定解析のための手続き
Next
Next
'以下各数字に対応する列におけるライン排除確定があるかを調べるための手順
For i = 0 To n_1 'i + 1 は入力する数字を示す。
For j = 0 To n_1 'jはy座標（縦座標）
w = 0
・
y(g) = ys(0)
x(g) = j
' cmx(g, y(g), x(g)) = mx(y(g), x(g))
' For l = 0 To n_1
' crlst(g, y(g), x(g), l) = rlst(y(g), x(g), l)
' Next
' For l = 0 To n_1
' ckh(g, y(g), x(g), l) = kh(y(g), x(g), l)
' Next
rlst(y(g), x(g), k) = rlst(y(g), x(g), 0)
rlst(y(g), x(g), 0) = i + 1
mx(y(g), x(g)) = 0
kh(y(g), x(g), i) = 0
' rh(g) = 1
Exit Function
End If
Next
End If
If w = 2 Then '以下相補確定のための手続き
For k = i + 1 To n_1
w = 0
For l = 0 To n_1
If p(l, j) = 0 Then
If kh(l, j, k) = 1 Then
ys1(w) = l
w = w + 1
End If
End If
Next
If w = 2 And ys(0) = ys1(0) And ys(1) = ys1(1) Then
If hth(g, j, ys(0)) = 0 Then '以下相補確定解析
sx(g, sc(g)) = j
sy(g, sc(g)) = ys(0)
' cmx(g, sy(g, sc(g)), sx(g, sc(g))) = mx(sy(g, sc(g)), sx(g, sc(g)))
' For l = 0 To n_1
' crlst(g, sy(g, sc(g)), sx(g, sc(g)), l) = rlst(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
' For l = 0 To n_1
' ckh(g, sy(g, sc(g)), sx(g, sc(g)), l) = kh(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
mx(sy(g, sc(g)), sx(g, sc(g))) = 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 0) = i + 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 1) = k + 1
' hth(g, sy(g, sc(g)), sx(g, sc(g))) = 1
sc(g) = sc(g) + 1
End If
If hth(g, j, ys(1)) = 0 Then
sx(g, sc(g)) = j
sy(g, sc(g)) = ys(1)
' cmx(g, sy(g, sc(g)), sx(g, sc(g))) = mx(sy(g, sc(g)), sx(g, sc(g)))
' For l = 0 To n_1
' crlst(g, sy(g, sc(g)), sx(g, sc(g)), l) = rlst(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
' For l = 0 To n_1
' ckh(g, sy(g, sc(g)), sx(g, sc(g)), l) = kh(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
mx(sy(g, sc(g)), sx(g, sc(g))) = 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 0) = i + 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 1) = k + 1
' hth(g, sy(g, sc(g)), sx(g, sc(g))) = 1
sc(g) = sc(g) + 1
End If '以上相補確定
' sh(g) = 1
Exit Function
End If
Next
End If '以上相補確定のための手続き
'以上行における白いセルのカウント
Next
Next
'以下各数字に対応するブロックにおけるライン排除確定があるかを調べるための手順
For i = 0 To n_1 'i + 1 は入力する数字を示す。
For j = 0 To n_1 'jはy座標（縦座標）
・
y(g) = ys(0)
x(g) = xs(0)
' cmx(g, y(g), x(g)) = mx(y(g), x(g))
' For l = 0 To n_1
' crlst(g, y(g), x(g), l) = rlst(y(g), x(g), l)
' Next
' For l = 0 To n_1
' ckh(g, y(g), x(g), l) = kh(y(g), x(g), l)
' Next
rlst(y(g), x(g), k) = rlst(y(g), x(g), 0)
rlst(y(g), x(g), 0) = i + 1
mx(y(g), x(g)) = 0
kh(y(g), x(g), i) = 0
' rh(g) = 1
Exit Function
End If
Next
End If
If w = 2 Then '以下相補確定解析に関する手続き
For k = i + 1 To n_1
w = 0
For l = 0 To n_1
ls = Int(l / rn)
la = l Mod rn
If p(ybs + ls, xbs + la) = 0 Then
If kh(ybs + ls, xbs + la, k) = 1 Then
xs1(w) = xbs + la
ys1(w) = ybs + ls
w = w + 1
End If
End If
Next
If w = 2 And (xs(0) = xs1(0) And ys(0) = ys1(0)) And (xs(1) = xs1(1) And ys(1) = ys1(1)) Then
If hth(g, ys(0), xs(0)) = 0 Then '以下相補確定
sx(g, sc(g)) = xs(0)
sy(g, sc(g)) = ys(0)
' cmx(g, sy(g, sc(g)), sx(g, sc(g))) = mx(sy(g, sc(g)), sx(g, sc(g)))
' For l = 0 To n_1
' crlst(g, sy(g, sc(g)), sx(g, sc(g)), l) = rlst(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
' For l = 0 To n_1
' ckh(g, sy(g, sc(g)), sx(g, sc(g)), l) = kh(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
mx(sy(g, sc(g)), sx(g, sc(g))) = 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 0) = i + 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 1) = k + 1
' hth(g, sy(g, sc(g)), sx(g, sc(g))) = 1
sc(g) = sc(g) + 1
End If
If hth(g, ys(1), xs(1)) = 0 Then
sx(g, sc(g)) = xs(1)
sy(g, sc(g)) = ys(1)
' cmx(g, sy(g, sc(g)), sx(g, sc(g))) = mx(sy(g, sc(g)), sx(g, sc(g)))
' For l = 0 To n_1
' crlst(g, sy(g, sc(g)), sx(g, sc(g)), l) = rlst(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
' For l = 0 To n_1
' ckh(g, sy(g, sc(g)), sx(g, sc(g)), l) = kh(sy(g, sc(g)), sx(g, sc(g)), l)
' Next
mx(sy(g, sc(g)), sx(g, sc(g))) = 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 0) = i + 1
rlst(sy(g, sc(g)), sx(g, sc(g)), 1) = k + 1
' hth(g, sy(g, sc(g)), sx(g, sc(g))) = 1
sc(g) = sc(g) + 1
End If '以上相補確定
' sh(g) = 1
Exit Function
End If
Next
End If '以上相補確定解析に関する手続き
'以上行における白いセルのカウント
Next
Next
End Function
Ver.2に相補確定解析を付け加えたプログラム
上記プログラムによって問題を１２００題生成するプログラム
その１２００題が適正な問題であるかを検証するプログラム
問題が適正であるというのは例の２つの基準
① 解が存在する
② 別解が存在しない
を満たすことです。
Ver.2に相補確定解析を付け加えたプログラムが適正な問題作り出しているか、
手作業で調べるのでは大変ですから、
それを自動で調べるためのプログラムが、
上記プログラムによって問題を１２００題生成するプログラム
その１２００題が適正な問題であるかを検証するプログラム
です。
上記プログラムによって問題を１２００題生成するプログラム
で問題を作らせ
それをコピーして、
その１２００題が適正な問題であるかを検証するプログラム
の
オレンジにペーストして実行ボタンを押すと、適正であることが証明されます。
では、ライン排除確定のときと同じように、
破綻処理を加えましょう。
