お絵かきロジックアナライザ開発記   その10

現状02 解答02 サンプル02

最も簡単な例題をクリアしましたので、徐々に問題の難易度を上げていきます。新たな例題が必要になってくるので右のような問題を準備しました。

アルファベットの“A”をイメージしたものです。上から4行目のヒント‘5’が全塗潰しになるのを足がかりに、簡単に答えが出るのですが、現状のプログラムでは一番右のように途中までしか解けません。まずは何度もループして、徐々に答えに近付くようなプログラム構造から考えていきましょう。

Doループで何度でもチェック

基本的にはDo-Loopステートメントでループを作っておき、分析に進展がない場合にループを抜けるような構造とします。ループ内では今後いろいろな方法で塗潰しや空白を確定させ、‘候補範囲’を狭めて行って完成を目指す方向です。

進展なし 塗潰しが見付かった例 候補範囲縮小により空白確定

例えば右図のようなヒントに対してヒント値[2]に対する候補範囲の初期値は[1〜6]、ヒント値[3]に対しては[4〜10]となりますが、右図中段のように垂直方向からひとつの塗潰しが決まった場合、範囲はそれぞれ[2〜4]、[5〜10]と狭まります。さてここからはこの候補範囲を狭める処理をコード化していく作業です。 


Option Explicit                                   '強制変数宣言
Option Base 1                                     '配列最小添字=1
' モジュール内共用変数宣言
Dim HintLen As Integer                            '列内ヒント数
Dim HintSumHrz As Integer                         '水平ヒント値合計
    ....

    ....
Dim PssStVrt() As Integer                         '垂直候補範囲始点
Dim PssEnVrt() As Integer                         '垂直候補範囲終点
Dim LpStp1 As Boolean                             '進捗フラグ

モジュール先頭の宣言部で共用変数としてLpStp1を定義し、この変数がTrueでなくなればDoループを抜出すようにします。ループ内で呼出されるサブプロシージャでは、何らかの進展があればLpStp1にTrueをセットする事として「進展がなくなった時点でループを抜ける」という構造を作ります。添字の‘1’は今後‘2’以降があることを示唆しています。つまり、進展フラグの階層により「簡単なチェックで分析作業が進んでいる間はそのまま繰返し、進展がなくなったら他の方法で分析する」という構造を目指します。つまり進展フラグのレベルが上がる問題は難易度が高いというコトになりますね。 


Sub AnalyzeSheet(Optional ByVal CallSwitch As Boolean)
' シート分析
  '＜初期設定＞
  ReDim ImgField(FieldHt, FieldWd)                '描画フィールド領域再定義
    ....

    ....
  '＜フィールド分析＞
  NonoModule.BlackOutCheck                        '初回塗潰しチェック
  Do
    LpStp1 = False                                '進捗フラグ初期化
    NonoModule.PSSrenewal                         '候補範囲更新
    NonoModule.BlackOutCheck                      '塗潰しチェック
    If Discrep Then Exit Do                       'エラーチェック
  Loop While LpStp1
  '＜終了表示＞
ExitAnalyzeSheet:
  If Discrep Then                                 '矛盾チェック
    MsgBox ErrorMsg, vbCritical + vbOKOnly, "分析エラー"
  End If
End Sub

AnalyzeSheetプロシージャにDoループを設置し、ループ内で「候補範囲の更新」「塗潰しチェック」を繰返す構造としています。進展があったかを示すLpStp1は、ここで呼出す子プロセスでも内容を変更するので宣言部で定義し共用化したワケです。LpStp1フラグで進展具合を確認し、進展がなければループを抜けるようになっています。それでは候補範囲を更新するPSSrenewalプロシージャを作成しておきましょう。内容的にはこれから進めていくこととし現時点ではカラっぽですが、今のままプログラムを走らせるとエラーになるので、プロシージャ名の定義だけは済ませておきます。 


Sub PSSrenewal(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新
End Sub

ではBlackOutCheckプロシージャ内で進展があればLpStp1をTrueとするよう変更してみます。 


Sub BlackOutCheck(Optional ByVal CallSwitch As Boolean)
' 塗潰しチェック
' ヒント値が候補範囲の１／２を越える場合、中央部塗潰が確定する。ヒント値と候補範
' 囲が等しければ塗潰ブロックが確定する。
    ....

    ....
  '＜水平方向スキャン＞
  For ScanCnt = 1 To FieldHt
    ....

    ....
      If HintVal > BlockLen / 2 Then              '黒塗潰あり
        For FieldCnt = BlockEn - HintVal + 1 To BlockSt + HintVal - 1
          If (ImgField(ScanCnt, FieldCnt) And &H1) <> &H1 Then
            LpStp1 = True
            ImgField(ScanCnt, FieldCnt) = ImgField(ScanCnt, FieldCnt) Or &H1
            NonoWorksheet.Cells(HintHt + ScanCnt, HintWd + FieldCnt) _
              .Interior.ColorIndex = 16
          End If
        Next FieldCnt
    ....

    ....
  '＜垂直方向スキャン＞
  For ScanCnt = 1 To FieldWd
    ....

    ....
      If HintVal > BlockLen / 2 Then              '黒塗潰あり
        For FieldCnt = BlockEn - HintVal + 1 To BlockSt + HintVal - 1
          If (ImgField(FieldCnt, ScanCnt) And &H1) <> &H1 Then
            LpStp1 = True
            ImgField(FieldCnt, ScanCnt) = ImgField(FieldCnt, ScanCnt) Or &H1
            NonoWorksheet.Cells(HintHt + FieldCnt, HintWd + ScanCnt) _
              .Interior.ColorIndex = 16
          End If
        Next FieldCnt
      End If
    Next HintCnt
    If Discrep Then Exit For
  Next ScanCnt
End Sub

新たな塗潰しを見つけた時点でLpStp1にTrueがセットされるようにしていますが、対称セルが既に塗潰されているかチェックした上で実際の塗潰し作業に移るような形となったため、ノーチェックでとにかく塗潰し作業をしていたときに比べ、メモリへの書込アクセスが減り、スピード面では有利に働きます。LpStp1フラグにより、進展があればループ処理を繰返すこととなります。

これで[Nonogram]→[シート分析]でプログラムを走らせることができるようになりました。実行してみると分るのですが、結果的にはなにも変っていません。ブレークポイントを設置するなどしてデバッグしてみても、BlackOutCheckプロシージャが2回呼出されるようになっただけで、ループ内での進展はまだありません(新たな「候補範囲縮小」アルゴリズムに手を付けていないので当然ですね)。ここからはPSSrenewalプロシージャのコーディングを進めるコトにします。

塗潰し補範囲更新 その1

端点に塗潰しが見付かった例 塗潰し範囲確定 所属範囲の定まらない塗潰し ヒント値3に属する場合 ヒント値2に属する場合

それではPSSrenewalプロシージャの中身を検討して行きましょう。まず最も簡単な候補範囲縮小のパターンは右図のように端が塗潰しになっている場合です。図では横方向のスキャンを説明しているのですが、縦方向スキャンで塗潰しが決まれば横方向の範囲更新が影響を受けるコトが解るでしょう。候補範囲内の黒をチェックすれば範囲を更新できそうです。しかしここで気を付けなければならないのが、複数のヒントのどこに属する塗潰しなのかを見極めるのが難しいということです。右図のようにヒント値が2と3で、左から4番目が黒だった場合、これが2の一部なのか、3の一部なのかは決まっていません。ヒント値3に属するのであればこの列の総てが確定するのですが、2に属する場合はまだ確定が得られません。「上の例みたいに一番端っコにあれば決まるなら‘端のヒントである場合は’という条件を加えればイイでしょ?」とも思うのですが、‘端っコ’のヒントが1列につき2つであると限らないコトもあります。大きなサイズのロジックになるとヒントの数も増え、その中の中央ヒントで確定になる塗潰しがあると、領域そのものが2つに分断され、端っコが1列に対し4つ発生することになります。条件の数まで変化する場合の処理は非常に面倒です。ここは少々妥協して、未解決ヒント郡が解決したヒントに分断される場合は分断点に端点を設定せず、常にその列の未解決ヒント端のみをチェックすることとします。

さて、鉛筆で解くタイプのお絵かきロジックでも、分析は1行づつ、1列づつチェックしていきますよね。PCで自動分析する場合も同様で、水平方向で上から順にスキャンし、垂直方向も同様にチェックして、これを繰返すことで解答に近付いて行きます。そこでPSSrenewalプロシージャに水平走査と垂直走査の骨格となるループを作っておきましょう。 


Sub PSSrenewal(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新
  Dim HintVal As Integer                          '対象ヒント値
  '＜水平方向スキャン＞
  For ScanCnt = 1 To FieldHt
    If PndStHrz(ScanCnt) > 0 Then                 '未解決ヒントを含む行のみ対象
  'ヒント走査 左→右
      For HintCnt = PndStHrz(ScanCnt) To PndEnHrz(ScanCnt)
        HintVal = HintHrz(ScanCnt, HintCnt)       '対象ヒント値取得
      Next HintCnt
  'ヒント走査 左←右
      For HintCnt = PndEnHrz(ScanCnt) To PndStHrz(ScanCnt) Step -1
        HintVal = HintHrz(ScanCnt, HintCnt)       '対象ヒント値取得
      Next HintCnt
    End If
  Next ScanCnt
  '＜垂直方向スキャン＞
  For ScanCnt = 1 To FieldHt
    If PndStVrt(ScanCnt) > 0 Then                 '未解決ヒントを含む列のみ対象
  'ヒント走査 上→下
      For HintCnt = PndStVrt(ScanCnt) To PndEnVrt(ScanCnt)
        HintVal = HintVrt(ScanCnt, HintCnt)       '対象ヒント値取得
      Next HintCnt
  'ヒント走査 上←下
      For HintCnt = PndEnVrt(ScanCnt) To PndStVrt(ScanCnt) Step -1
        HintVal = HintVrt(ScanCnt, HintCnt)       '対象ヒント値取得
      Next HintCnt
    End If
  Next ScanCnt
End Sub

水平スキャンと垂直スキャンを更に‘左から右’と‘右から左’、‘上から下’と‘下から上’の4つに分け、右向または下向スキャンで範囲始点を、左向または上向スキャンで範囲終点をそれぞれ更新する構造になるってコトです。現在はヒント値を取得するのみになっていますが、これからループ内をコーディングしていきます。

塗潰しを足掛かりに候補範囲を狭めるには以下の条件をチェックします。

  1. 範囲外から続く連続塗潰しは除外。ただし単独配属フィールド内で見付かった場合は矛盾。
  2. 範囲端にヒント値を超える連続塗潰しがある場合は除外。ただし単独配属フィールド内で見付かった場合は矛盾。
  3. 単独範囲内にヒント値以下の連続塗潰しがある場合は、そこから計算される範囲に更新。

それでは手始めに1つめの「範囲外から続く連続塗潰しは除外」をコーディングしてみましょう。 


Sub PSSrenewal(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新
' ヒント値を上下左右の端点から走査し、以下のチェックを行って候補範囲を縮小する。
' ・候補範囲外から続く連続塗潰しがあれば範囲から除外。
  Dim HintVal As Integer                          '対象ヒント値
  Dim FieldPos As Integer                         'フィールドポインタ
  Dim AreaSt As Integer                           '更新始点ポインタ
  Dim AreaEn As Integer                           '更新終点ポインタ
  '＜水平方向スキャン＞
  For ScanCnt = 1 To FieldHt
    If PndStHrz(ScanCnt) > 0 Then                 '未解決ヒントを含む行のみ対象
  'ヒント走査 左→右
      For HintCnt = PndStHrz(ScanCnt) To PndEnHrz(ScanCnt)
        HintVal = HintHrz(ScanCnt, HintCnt)       '対象ヒント値取得
        If HintVal > 0 Then                       'ヒント値０は無視
          AreaSt = PssStHrz(ScanCnt, HintCnt)     '更新ポインタ初期化
          AreaEn = PssEnHrz(ScanCnt, HintCnt)
          If HintCnt > PndStHrz(ScanCnt) Then     '未解決左端ヒントは対象外
            Do While (ImgField(ScanCnt, AreaSt - 1) And &H3) = &H1
              If AreaSt < FieldWd Then
                AreaSt = AreaSt + 1
              Else
                Exit Do
              End If
            Loop
          End If
          If AreaEn - AreaSt + 1 >= HintVal Then
            If PssStHrz(ScanCnt, HintCnt) < AreaSt Then
              LpStp1 = True                       '進展チェック
              PssStHrz(ScanCnt, HintCnt) = AreaSt '始点更新
            End If
          Else
            Discrep = True                        '矛盾発見
            Exit For
          End If
        End If
      Next HintCnt
      If Discrep Then Exit For
  'ヒント走査 左←右
      For HintCnt = PndEnHrz(ScanCnt) To PndStHrz(ScanCnt) Step -1
        HintVal = HintHrz(ScanCnt, HintCnt)       '対象ヒント値取得
        If HintVal > 0 Then                       'ヒント値０は無視
          AreaSt = PssStHrz(ScanCnt, HintCnt)     '更新ポインタ初期化
          AreaEn = PssEnHrz(ScanCnt, HintCnt)
          If HintCnt < PndEnHrz(ScanCnt) Then     '未解決右端ヒントは対象外
            Do While (ImgField(ScanCnt, AreaEn + 1) And &H3) = &H1
              If AreaEn > 1 Then
                AreaEn = AreaEn - 1
              Else
                Exit Do
              End If
            Loop
          End If
          If AreaEn - AreaSt + 1 >= HintVal Then
            If PssEnHrz(ScanCnt, HintCnt) > AreaEn Then
              LpStp1 = True                       '進展チェック
              PssEnHrz(ScanCnt, HintCnt) = AreaEn '終点更新
            End If
          Else
            Discrep = True                        '矛盾発見
            Exit For
          End If
        End If
      Next HintCnt
      If Discrep Then Exit For
    End If
  Next ScanCnt
  '＜垂直方向スキャン＞
  For ScanCnt = 1 To FieldHt
    If PndStVrt(ScanCnt) > 0 Then                 '未解決ヒントを含む行のみ対象
  'ヒント走査 上→下
      For HintCnt = PndStVrt(ScanCnt) To PndEnVrt(ScanCnt)
        HintVal = HintVrt(ScanCnt, HintCnt)       '対象ヒント値取得
        If HintVal > 0 Then                       'ヒント値０は無視
          AreaSt = PssStVrt(ScanCnt, HintCnt)     '更新ポインタ初期化
          AreaEn = PssEnVrt(ScanCnt, HintCnt)
          If HintCnt > PndStVrt(ScanCnt) Then     '未解決上端ヒントは対象外
            Do While (ImgField(AreaSt - 1, ScanCnt) And &H3) = &H1
              If AreaSt < FieldHt Then
                AreaSt = AreaSt + 1
              Else
                Exit Do
              End If
            Loop
          End If
          If AreaEn - AreaSt + 1 >= HintVal Then
            If PssStVrt(ScanCnt, HintCnt) < AreaSt Then
              LpStp1 = True                       '進展チェック
              PssStVrt(ScanCnt, HintCnt) = AreaSt '始点更新
            End If
          Else
            Discrep = True                        '矛盾発見
            Exit For
          End If
        End If
      Next HintCnt
      If Discrep Then Exit For
  'ヒント走査 上←下
      For HintCnt = PndEnVrt(ScanCnt) To PndStVrt(ScanCnt) Step -1
        HintVal = HintVrt(ScanCnt, HintCnt)       '対象ヒント値取得
        If HintVal > 0 Then                       'ヒント値０は無視
          AreaSt = PssStVrt(ScanCnt, HintCnt)     '更新ポインタ初期化
          AreaEn = PssEnVrt(ScanCnt, HintCnt)
          If HintCnt < PndEnVrt(ScanCnt) Then     '未解決下端ヒントは対象外
            Do While (ImgField(AreaEn + 1, ScanCnt) And &H3) = &H1
              If AreaEn > 1 Then
                AreaEn = AreaEn - 1
              Else
                Exit Do
              End If
            Loop
          End If
          If AreaEn - AreaSt + 1 >= HintVal Then
            If PssEnVrt(ScanCnt, HintCnt) > AreaEn Then
              LpStp1 = True                       '進展チェック
              PssEnVrt(ScanCnt, HintCnt) = AreaEn '終点更新
            End If
          Else
            Discrep = True                        '矛盾発見
            Exit For
          End If
        End If
      Next HintCnt
      If Discrep Then Exit For
    End If
  Next ScanCnt
End Sub

右向または下向走査で範囲始点を、左向または上向走査で範囲終点をそれぞれ更新しています。結果的に候補範囲がヒント値を下回れば矛盾となり、Discrepフラグを立ててプロシージャを抜けます。ちょっと解説が要りそうなのが4回出てくるDo While (ImgField(ScanCnt, AreaSt - 1) And &H3) = &H1などの部分でしょう。ループ条件を「チェック対象位置の1マス分外側が塗潰しならループ継続」という条件なのですが、ここで出てくるAnd演算子は真理値の論理積(True/False)を求めるのではなく、ビット演算のために使っています。ImgField()配列は下位ビットより‘塗潰し’‘空白’‘確定’を示すのですから、仮定状態か確定状態はマスクして「空白なのか塗潰しなのか」だけを取出し、塗潰しであればループを続ける、という条件をコード化しています。試しに条件式全体を括っている括弧を外して分析を実行してみると、And演算子がビット演算としてではなく論理積演算として使われてDoループに入ってこないことが解ります。

ブレークポイントを設定し、このページ冒頭の例でメニューバーから分析をしてみましょう。縦ヒント中央3列はこのプロシージャによって候補範囲が縮まっているのが確認できるのですが、PssEnVrt()配列をチェックしなければなりません。イミディエイトウィンドウで配列名を入力して1つずつ確認するのは少々骨が折れますので、プロシージャ内に4回登場するLpStp1 = Trueにブレークポイントを置き、このIfブロックに入ってきたときのPssStHrz()などにマウスオーバーして内容を確認するとよいでしょう。

“監視カメラ”を設置

シート状の描画イメージに変化のないコーディングが続いていると、プログラム内容の検証のため、変数や配列を監視しなければならず、ちょっとイライラしてきます。候補範囲がどう変化しているのかをブレークポイントの設置と配列内容のチェックで行う方法は何かと不便で「とにかく一括出力だけでもできないかな」と考えるのは当然の成行きと言えます。そこでイミディエイトウィンドウに候補範囲情報を出力させるようにしてみましょう。VBEが動作していない状態では、ワークシート上に何らかの支障があるワケでもないので、不要になったコード記述を残しておいてもマクロ実行に影響はありません(シビアに見れば実行時間に多少の影響はあるでしょうが)。 


Sub PSSrenewal(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新
' ヒント値を上下左右の端点から走査し、以下のチェックを行って候補範囲を縮小する。
' ・候補範囲外から続く連続塗潰しがあれば範囲から除外。
  Dim HintVal As Integer                          '対象ヒント値
  Dim FieldPos As Integer                         'フィールドポインタ
  Dim AreaSt As Integer                           '更新始点ポインタ
  Dim AreaEn As Integer                           '更新終点ポインタ
  NonoModule.PSSresult                            '候補範囲デバッグ表示
  '＜水平方向スキャン＞
  For ScanCnt = 1 To FieldHt
    If PndStHrz(ScanCnt) > 0 Then                 '未解決ヒントを含む行のみ対象
  'ヒント走査 左→右
      For HintCnt = PndStHrz(ScanCnt) To PndEnHrz(ScanCnt)
    ....



Sub PSSresult(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新結果出力(デバッグ用)
  Dim SecLen As Byte
  If FieldWd > FieldHt Then
    SecLen = Len(CStr(FieldWd))
  Else
    SecLen = Len(CStr(FieldHt))
  End If
  Debug.Print ""
  Debug.Print "Horizontal"
  For ScanCnt = 1 To FieldHt
    For HintCnt = 1 To HintCntHrz(ScanCnt)
      Debug.Print Right("  " & CStr(HintHrz(ScanCnt, HintCnt)), SecLen) & ":" _
      & Right("  " & CStr(PssStHrz(ScanCnt, HintCnt)), SecLen) & "-" _
      & Right("  " & CStr(PssEnHrz(ScanCnt, HintCnt)), SecLen) & " ";
    Next HintCnt
    Debug.Print ""
  Next ScanCnt
  Debug.Print "Vertical"
  For ScanCnt = 1 To FieldWd
    For HintCnt = 1 To HintCntVrt(ScanCnt)
      Debug.Print Right("  " & CStr(HintVrt(ScanCnt, HintCnt)), SecLen) & ":" _
      & Right("  " & CStr(PssStVrt(ScanCnt, HintCnt)), SecLen) & "-" _
      & Right("  " & CStr(PssEnVrt(ScanCnt, HintCnt)), SecLen) & " ";
    Next HintCnt
    Debug.Print ""
  Next ScanCnt
End Sub

候補範囲更新を行う前に候補範囲表示をしている点は、ちょっと不自然に見えるかもしれません。「結果表示ならPSSrenewalプロシージャの末尾でPSSresultを呼出さないといけないのでは?」とも感じますが、実際にそのような状態で動作させてみると範囲更新がなされる前の‘初期状態’が出力されなくなってしまいます。またLpStp1がTrueでなくなり、Doループを抜ける直前で呼出されたPSSresultが最終結果を出力していることになり、これで初期状態から最終状態までをリポートできます。

分析を実行するとイミディエイトウィンドウに以下のような結果表示がされます。 


Horizontal
1:1-5 
1:1-3 1:3-5 
1:1-3 1:3-5 
5:1-5 
1:1-3 1:3-5 
Vertical
3:1-5 
1:1-3 1:3-5 
1:1-3 1:3-5 
1:1-3 1:3-5 
3:1-5 

Horizontal
1:1-5 
1:1-3 1:3-5 
1:1-3 1:3-5 
5:1-5 
1:1-3 1:3-5 
Vertical
3:1-5 
1:1-2 1:3-5 
1:1-2 1:3-5 
1:1-2 1:3-5 
3:1-5
例1012 例1013

反転文字にした部分が候補範囲の更新された結果です。最初は1〜3マス目が候補範囲だったのが、PSSrenewalプロシージャにより範囲が1〜2に更新されています。ロジックシート上のイメージで説明したのが左図で、対象となるヒント値とその候補範囲を水色で示しています。初期状態では第1ヒントの候補範囲は上から3マス目までですが、下から2番目が塗潰しとなり「範囲外から続く塗潰し」のチェックにより、範囲が1マス縮小されます。縮小された後で「範囲外」となる3番目のマスは塗潰しではないため範囲更新はここまでで終わります。

ここまでのコーディングで分かるように、自分が鉛筆でアナログチックに考えている思考パターンをプログラムコードに置換える作業は非常に面倒なワリに、見た目の進展はそれほどでもないという状況は、コーディング作業をかなりキツいものにしています。つまり苦労の割に結果は微々たるモノで、途中であきらめようかと思うことも多々ありました。しかもこの‘置換え’作業でミスってしまうと分析が破綻して、ヘタするとかなり遡ってプログラムし直す場面もありました。一応満足できる結果が得られた後にこのページを書いているため、非常にスムーズな進み方をしているように見えるかもしれませんが、このようなカタチに至るまでには、かなりの見直しがあったワケです。この先も「思考プロセスのプログラム化」が、コードサイズとしてかなりのボリュームになるのに、ロジックシート上の見てくれが変化しないような場面も結構出てきます。そこで次節ではミスによるコーディング見直しを少しでも減らすような工夫について解説していきます。

← 前へ   → 次へ ▲ ページトップ