VBAサンプル集
数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証№3

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
公開日:2013年5月以前 最終更新日:2017-11-26

数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証№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の学習用(№1)
Excel囲碁:万波奈穂先生に捧ぐ
Excel囲碁:再起動後も続けて打てるように改造


新着記事NEW ・・・新着記事一覧を見る

TRIMRANGE関数(セル範囲をトリム:端の空白セルを除外)|エクセル入門(2024-08-30)
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)


アクセスランキング ・・・ ランキング一覧を見る

1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.セルのクリア(Clear,ClearContents)|VBA入門
8.メッセージボックス(MsgBox関数)|VBA入門
9.条件分岐(Select Case)|VBA入門
10.マクロとは?VBAとは?VBAでできること|VBA入門




このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。


記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。


このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
本文下部へ