数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証3
数独(ナンプレ)を解くアルゴリズムを例に、アルゴリズムの要点と、それによるパフォーマンスを検証します、
いきなり、大幅に改善されてしまいましたので、
目的はほとんど達成された感じなのですが、もう少し改善してみましょう。
プロシージャーchkSuは、指定数値が置けるかどうかだけ確認しているのですが、
なんとなく、勿体ないと感じます。
せっかく、縦・横・枠内を確認するのなら、置ける数値の一覧を配列で返してやれば、
その後の処理も楽になると言うもの。
これは、パフォーマンスの為と言うより、プログラミングのテクニック的な意味合いが強くなります。
今後の改修を考え、より適切なアルゴリズムに変更しようというものです。
ただし、変更内容からして、試行回数そのものが減る事はありません。
しかし、1〜9を毎回、縦・横・枠内とチェックするなら、一度にチェックしてしまった方が良いのは明白。
後は、パフォーマンスがどこまで改善されるかです。
chkSuで、置ける数値の配列を返すようにして、
これに伴い、他のプロシージャーも変更しました。
Option Explicit Private tryCnt As Long Sub main() Debug.Print Timer Dim SuAry(1 To 9, 1 To 9) As Integer Dim i1 As Integer Dim i2 As Integer tryCnt = 0 Erase SuAry For i1 = 1 To 9 For i2 = 1 To 9 If Cells(i1, i2) = "" Then Cells(i1, i2).Font.Color = vbBlue Else SuAry(i1, i2) = Cells(i1, i2) End If Next Next Call trySu(SuAry) Range("A1:I9").Value = SuAry Debug.Print Timer If getBlank(SuAry(), i1, i2) = False Then MsgBox "解読成功" & vbLf & tryCnt Else MsgBox "あれれ・・・" End If End Sub Function trySu(ByRef SuAry() As Integer) As Boolean Dim i1 As Integer Dim i2 As Integer Dim su As Integer Dim tryAry() As Integer If getBlank(SuAry(), i1, i2) = False Then trySu = True Exit Function End If If chkSu(SuAry(), i1, i2, tryAry()) <> 0 Then For su = 1 To 9 If tryAry(su) <> 0 Then SuAry(i1, i2) = su tryCnt = tryCnt + 1 Cells(i1, i2) = su If trySu(SuAry) = True Then trySu = True Exit Function End If End If Next End If SuAry(i1, i2) = 0 Cells(i1, i2) = "" DoEvents trySu = False End Function Function getBlank(ByRef SuAry() As Integer, ByRef i1 As Integer, ByRef i2 As Integer) As Boolean Dim cnt As Integer Dim tryMin As Integer Dim i1Min As Integer Dim i2Min As Integer Dim tryAry() As Integer tryMin = 10 For i1 = 1 To 9 For i2 = 1 To 9 If SuAry(i1, i2) = 0 Then cnt = chkSu(SuAry, i1, i2, tryAry) If tryMin > cnt Then i1Min = i1 i2Min = i2 tryMin = cnt End If End If Next Next If tryMin = 10 Then getBlank = False Else i1 = i1Min i2 = i2Min getBlank = True End If End Function Function chkSu(ByRef SuAry() As Integer, ByVal i1 As Integer, ByVal i2 As Integer, ByRef tryAry() As Integer) As Integer Dim ix1 As Integer Dim ix2 As Integer Dim i1S As Integer Dim i2S As Integer chkSu = False ReDim tryAry(1 To 9) For ix1 = 1 To 9 tryAry(ix1) = ix1 Next '横をチェック For ix2 = 1 To 9 If ix2 <> i2 Then If SuAry(i1, ix2) <> 0 Then tryAry(SuAry(i1, ix2)) = 0 End If End If Next '縦をチェック For ix1 = 1 To 9 If ix1 <> i1 Then If SuAry(ix1, i2) <> 0 Then tryAry(SuAry(ix1, i2)) = 0 End If End If Next '枠内をチェック i1S = (Int((i1 + 2) / 3) - 1) * 3 + 1 i2S = (Int((i2 + 2) / 3) - 1) * 3 + 1 For ix1 = i1S To i1S + 2 For ix2 = i2S To i2S + 2 If ix1 <> i1 Or ix2 <> i2 Then If SuAry(ix1, ix2) <> 0 Then tryAry(SuAry(ix1, ix2)) = 0 End If End If Next Next chkSu = 0 For ix1 = 1 To 9 If tryAry(ix1) <> 0 Then chkSu = chkSu + 1 End If Next End Function |
大幅に変更しています。
本来、このようにした方が良いのは間違いないでしょう。
1のアルゴリズムは、1万〜7万の試行回数で、0.2秒〜0.8秒
2のアルゴリズムは、90〜800の試行回数で、0.1秒〜0.4秒
3のアルゴリズムは、90〜800の試行回数で、0.05秒〜0.2秒
この数値を見る限り、パフォーマンスは確実に改善されました。
ただし、必ずしも比例して改善されるわけではありません。
1で試行回数がわりと少なくても、2では結構多いと言う事もあります。
これは問題の質によるものです。
だからと言って、2で試行回数の多い問題の方が、より難問なのかどうか・・・
これは、解く人間の解法に依存するものなのでしょうね。
しかし、確かに改善はされたものの、
途中結果をセルに表示させた場合は、セル表示に時間がかかる為、その差を体感できるものではないです。
つまり、ここにも要点があります。
途中結果をセルに表示することを前提にプログラミングするなら、
今回の変更はパフォーマンスの観点では、ほとんど意味をなしていないということです。
途中結果をセルに表示するなら、セルへの数値の仮り置き回数を減らす事以外は、
ほとんどパフォーマンスに影響しないということです。
時に、この本質を忘れて議論されることがあります。
パフォーマンスを重視するなら、
数独に限らず、問題の本質・前提条件を考慮し、
よりパフォーマンスに影響があるアルゴリズムを検討すべきです。
しかし、この議論も、現時点での話です。
今後、各種の数独の解法を組み込む場合は、候補数値の配列は必ず必要になってくるものです。
候補数値を一定の評価することで、一意に決められるマスが存在しているはずです。
この候補数値から、一定の規則で一意の数値を絞り込む事こそ、数独の楽しみなのでしょうけど・・・
これを見つけるアルゴリズムを考え、プログラミングしていけば、
より少ない試行回数で解を求める事ができるようになるはずです。
具体的には、chkSuを使い、全ての空きマスの候補数値を配列に格納し、
その中から一定の規則で一意に出来る箇所を探すというような事になるかと思います。
一か所でも一意に出来れば、それにより、他の箇所が影響を受けるので、
再度、chkSuを使い、全ての空きマスの候補数値を配列に格納する。
これを繰り返せば良い訳です。
これはあくまで想像ですが、最初の数個を一意に出来れば、
後はいもずる式に決定されていくでしょうし、残りを全数チェックしても試行回数は極端に減る筈です。
25×25のような数独を解くなら、このようなアルゴリズムは必須になってくることは言うまでもありません。
ただし、9×9の数独において、
途中結果をセルに表示しないのなら、
パフォーマンスの観点だけで言えば、個別の数独の解法を組み込む事は疑問があります。
それは、候補数値を一定の評価する為の処理時間がかかってしまう為、
必ずしも期待するほど、速く解にたどり着けるとは限らないからです。
逆に、途中結果をセルに表示するなら、
各種の解法を次々に組み込むことで、試行回数が減り、
少しでも試行回数が減れば、それだけパフォーマンスは改善されます。
つまり、問題の本質・前提条件次第なのです。
ここを見誤ると、
その労に見合う結果が得られないと言う事になります。
数独のように趣味でやるものなら良いのですが、
仕事の中においての事なら、費用対効果にそぐわない作業となってしまう可能性が大きいと言う事です。
以上のように、アルゴリズムの要点を見つけ、そこを重点的に改善することで、
プログラムのパフォーマンスは大きく改善されます。
ただし、その要点とは、あくまで目的を達成するための要点でなければなりません。
そして、そのアルゴリズムの要点以外の部分は、
少しくらいの改善では、パフォーマンスにはほとんど影響がないのです。
プログラムのパフォーマンスに重点を置くなら、
アルゴリズムの中でパフォーマンスに影響のある要点を見つける事に注力し、
その要点を徹底的に改善しましょう。
※その後
見直す機会があって、本の少し改善しました。
4へ続きます。
数独を解くアルゴリズムの要点とパフォーマンスの検証 1 2 3 4
こちらの最終完成版のダウンロード
同じテーマ「マクロVBAサンプル集」の記事
エクセルでファイル一覧を作成
アメブロの記事本文をVBAでバックアップする1
数独(ナンプレ)を解くVBAに挑戦1
数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証1
ナンバーリンク(パズル)を解くVBAに挑戦1
ナンバーリンクを解くVBAのパフォーマンス改善1
オセロを作りながらマクロVBAを学ぼう
他ブックへのリンクエラーを探し解除
Excelシートの複雑な計算式を解析するVBA
新着記事 ・・・新着記事一覧を見る
Excelシートの複雑な計算式を解析するVBA|VBAサンプル集(2月18日)
VBAクラスの作り方:独自Rangeっぽいものを作ってみた|VBA技術解説(2月16日)
VBAクラスの作り方:列名のプロパティを自動作成する|VBA技術解説(2月14日)
VBAクラスの作り方:列名の入力支援と列移動対応|VBA技術解説(2月11日)
クラスを使って他ブックのイベントを補足する|VBA技術解説(2月6日)
Excelアドインの作成と登録について|VBA技術解説(2月3日)
参照設定、CreateObject、オブジェクト式の一覧|VBA技術解説(1月20日)
VBAでファイルを規定のアプリで開く方法|VBA技術解説(1月20日)
ドキュメントプロパティ(BuiltinDocumentProperties,CustomDocumentProperties)|VBA技術解説(1月19日)
他ブックへのリンクエラーを探し解除|VBAサンプル集(1月15日)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数とデータ型(Dim)|ExcelマクロVBA入門
4.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
5.RangeとCellsの使い方|ExcelマクロVBA入門
6.マクロって何?VBAって何?|ExcelマクロVBA入門
7.繰り返し処理(For Next)|ExcelマクロVBA入門
8.とにかく書いて見よう(Sub,End Sub)|VBA入門
9.定数と型宣言文字(Const)|ExcelマクロVBA入門
10.ひらがな⇔カタカナの変換|エクセル基本操作
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
なお、掲載のVBAコードは自己責任で使ってください。万一データ破損等の損害が発生しても責任は負いません。