第６講 数独作成アプリVer.1にライン排除確定を組み込む
第９話 数独作成アプリVer.2の完成！
コードの変更部分のみを掲載
・
・
Function rhk(g As Byte) 'ライン排除確定解析プロシージャ
rhk = 1
Dim i As Byte, j As Byte, k As Byte, l As Byte, w As Byte 'wは行･列・ブロックにおける白の個数を数えるカウンタ
'将来相補確定とは排除の解析を導入できるように配列にしておく。
Dim ys(8) As Byte
Dim xs(8) As Byte
'現時点では上の配列のみを使用。
Dim ys1(8) As Byte
Dim xs1(8) As Byte
Dim ys2(8) As Byte
Dim xs2(8) As Byte
rh(g) = 0
'以下各数字に対応する行におけるライン排除確定があるかを調べるための手順
For i = 0 To n_1 'i + 1 は入力する数字を示す。
For j = 0 To n_1 'jはy座標（縦座標）
'以下行における白のセルのカウント
w = 0
For k = 0 To n_1 'kはx座標（横座標）
If p(j, k) = 0 Then
If kh(j, k, i) = 1 Then
xs(w) = k
w = w + 1
End If
End If
Next
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), k) = rlst(y(g), x(g), 0)
rlst(y(g), x(g), 0) = i + 1
mx(y(g), x(g)) = 0
rh(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
For k = 0 To n_1 'kはx座標（横座標）
If p(k, j) = 0 Then
If kh(k, j, i) = 1 Then
ys(w) = k
w = w + 1
End If
End If
Next
If w = 1 Then
For k = 0 To mx(ys(0), j)
If rlst(ys(0), j, k) = i + 1 Then
For l = 0 To n_1 '以下ライン排除確定による破綻解析
If l <> j And p(ys(0), l) = 0 Then
If mx(ys(0), l) = 0 And rlst(ys(0), 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 <> ys(0) And p(l, j) = 0 Then
If mx(l, j) = 0 And rlst(l, j, 0) = i + 1 Then
rh(g) = 0
rhk = 0
Exit Function
End If
End If
Next
ybs = rn * Int(ys(0) / rn)
xbs = rn * Int(j / rn)
For l = 0 To n_1
ls = Int(l / rn)
la = l Mod rn
If ybs + ls <> ys(0) And xbs + la <> j 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) = 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
rh(g) = 1
Exit Function
End If
Next
End If
'以上行における白いセルのカウント
Next
Next
'以下各数字に対応するブロックにおけるライン排除確定があるかを調べるための手順
Dim ks As Byte, ka As Byte
For i = 0 To n_1 'i + 1 は入力する数字を示す。
For j = 0 To n_1 'jはy座標（縦座標）
ybs = rn * Int(j / rn)
xbs = rn * (j Mod rn)
'以下行における白のセルのカウント
w = 0
For k = 0 To n_1 'kはx座標（横座標）
ks = Int(k / rn)
ka = k Mod rn
If p(ybs + ks, xbs + ka) = 0 Then
If kh(ybs + ks, xbs + ka, i) = 1 Then
ys(0) = ybs + ks
xs(0) = xbs + ka
w = w + 1
End If
End If
Next
If w = 1 Then
For k = 0 To mx(ys(0), xs(0))
If rlst(ys(0), xs(0), k) = i + 1 Then
For l = 0 To n_1 '以下ライン排除確定による破綻解析
If l <> xs(0) And p(ys(0), l) = 0 Then
If mx(ys(0), l) = 0 And rlst(ys(0), 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 <> ys(0) 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(ys(0) / rn)
xbs = rn * Int(xs(0) / rn)
For l = 0 To n_1
ls = Int(l / rn)
la = l Mod rn
If ybs + ls <> ys(0) 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) = 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
rh(g) = 1
Exit Function
End If
Next
End If
'以上行における白いセルのカウント
Next
Next
End Function
Function nck(g As Byte, mok As Byte)
nck = 1
・
If mok = 1 Then
nck = rhk(g)
End If
End Function
・
数独作成アプリVer.2
次は、相補確定とその排除の組み込むです。
試行錯誤法＝トライ＆エラー＝仮定法＝仮置き法＝背理法を捨て去るのは、
最終バージョンであると前に申し上げましたが、
第７講の相補確定とその排除を組み込んだときに、
３００題に１題の割合で別解のある問題を表示してしまうという不具合を発見して、
解消するための方法を模索しているときに、
数独作成アプリVer.2
の段階で仮定法を捨て去っても、
問題作成時間にほとんど影響を与えないことが分かりました。
そこで、第７講が試行錯誤の方法を捨て去ることにします。
今までずっとわれわれを悩ませ続けていた復元は、
これ以降心配する必要がありません。
確定法で解けない問題は、その時点で捨て去って良いからです。
前のセルに戻ってやり直す必要はないわけです。
さらに、仮定法を捨て去ったことによって、
別解のある問題を表示する可能性も０となりました。
確定法で解けるということは、解が１つしかないし、
確定法で解けない問題は、解が複数あるということなのですから。
eclipse c++ 入門
魔方陣 数独（ナンプレ）で学ぶ VBA 入門
数独（ナンプレ）のシンプルな解き方・簡単な解法の研究
vc++講義へ
excel 2013 2010 2007 vba入門へ
ＶＢ講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
専門用語なしの C言語 C++ 入門（Visual C++ 2010で学ぶ C言語 C++ 入門）
専門用語なしの excel vba マクロ 入門 2013 2010 2007 対応講義 第1部
eclipse java 入門へ
excel 2016 vba 入門へ
小学生からエンジニアまでのRuby入門へ
本サイトトップへ
