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

付加機能の脇道が長くなりましたが、ここからは分析機能の充実に取りかかっていきます。例題として作った「こいのぼり」ロジックは、現状で右のような結果になるハズです。パッと見て上から4行目の一番左は空白になり、ヒント値9に対して塗潰しが2マス伸びるのは明らかですが、これをPCに理解させるのがここでの問題です。上から10行目と13行目も全く同じ状態ですね。

他にもこの状態で明確な進展を挙げてみます(上記3行分も含みます)。以下の記述は総て左上を基点として数を数えています。

• 3行目6列目空白
• 4行目1列目空白/12〜13列目塗潰し
• 5行目1列目空白/5列目空白/6列目塗潰し
• 6行目6列目空白
• 8行目6列目空白
• 9行目1列目空白/5列目空白/6列目塗潰し
• 10行目1列目空白/12〜13列目塗潰し
• 13行目1列目空白/12〜13列目塗潰し
• 14行目1列目空白/5列目空白/6列目塗潰し
• 15行目6列目空白

縦方向に目を移すと次のような確定が見付かります。

• 9列目9行目空白/14行目空白
• 10列目9行目空白/14行目空白
• 12列目1行目空白

ここで用いる思考方法を候補範囲縮小の観点から見てみましょう。領域は空白によって区切られますが、区切られた部分がヒント値よりも小さければ候補範囲から除外できます。例えば判りやすいのが12列目1行目の空白です。ヒント値2に対して、空白によって区切られる未定部分が1マスしかなく、ここに‘2’は入らないので候補範囲から除外され、所属ヒントが無くなるので空白確定というロジックです。

塗潰し補範囲更新 その5

候補範囲の端から調べて、空白で区切られる領域(塗潰し、未定は問わない)がヒント値よりも小さい場合、そこは該当するヒントに属していないと考えられます。そこで候補範囲端に空白があったら範囲縮小する部分を少し改造して「範囲端から調べて空白があった場合に、その空白によって区切られる範囲がヒント値未満であれば範囲縮小する」という構造に変更してみます。

Sub PSSrenewal(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新
' ヒント値を上下左右の端点から走査し、以下のチェックを行って候補範囲を縮小する。
' ・先行する候補範囲端点からヒント値＋１（必ず挿入される空白分）を加えた点が現行
'   端点より内側なら範囲更新。
' ・候補範囲外から続く連続塗潰しがあれば範囲から除外。
' ・単独ヒント配属または未解決端の塗潰し検出時は範囲更新。
' ・候補範囲端に空白があれば範囲から除外。
' ・候補範囲端にヒント値よりも小さな空白で区切られる領域があれば範囲から除外。
  Dim HintVal As Integer                          '対象ヒント値
    ....

    ....
  '＜水平方向スキャン＞
    ....

    ....
  'ヒント走査 左→右
      For HintCnt = PndStHrz(ScanCnt) To PndEnHrz(ScanCnt)
    ....

    ....
  '候補範囲左端の空白までを除外
          FieldPos = AreaSt
          FieldCnt = 0
          Do While CheckWhite(ScanCnt, AreaSt)FieldPos < AreaEn - HintVal + 1
            If AreaSt < FieldWdCheckWhite(ScanCnt, FieldPos) Then
              AreaSt = AreaSt + 1
              If FieldCnt < HintVal Then
                AreaSt = FieldPos + 1
                FieldCnt = 0
              End If
            Else
              Exit Do
              FieldCnt = FieldCnt + 1
            End If
            FieldPos = FieldPos + 1
          Loop
  '候補範囲更新
    ....

    ....
  'ヒント走査 左←右
    ....

    ....
  '候補範囲右端の空白までを除外
          FieldPos = AreaEn
          FieldCnt = 0
          Do While CheckWhite(ScanCnt, AreaEn)FieldPos > AreaSt + HintVal - 1
            If AreaEn > 1CheckWhite(ScanCnt, FieldPos) Then
              AreaEn = AreaEn - 1
              If FieldCnt < HintVal Then
                AreaEn = FieldPos - 1
                FieldCnt = 0
              End If
            Else
              Exit Do
              FieldCnt = FieldCnt + 1
            End If
            FieldPos = FieldPos - 1
          Loop
  '候補範囲更新
    ....

    ....
  '＜垂直方向スキャン＞
    ....

    ....
  'ヒント走査 上→下
    ....

    ....
  '候補範囲上端の空白までを除外
          FieldPos = AreaSt
          FieldCnt = 0
          Do While CheckWhite(AreaSt, ScanCnt)FieldPos < AreaEn - HintVal + 1
            If AreaSt < FieldHtCheckWhite(FieldPos, ScanCnt) Then
              AreaSt = AreaSt + 1
              If FieldCnt < HintVal Then
                AreaSt = FieldPos + 1
                FieldCnt = 0
              End If
            Else
              Exit Do
              FieldCnt = FieldCnt + 1
            End If
            FieldPos = FieldPos + 1
          Loop
  '候補範囲更新
    ....

    ....
  'ヒント走査 上←下
    ....

    ....
  '候補範囲下端の空白までを除外
          FieldPos = AreaEn
          FieldCnt = 0
          Do While CheckWhite(AreaEn, ScanCnt)FieldPos < AreaSt + HintVal - 1
            If AreaEn > 1CheckWhite(FieldPos, ScanCnt) Then
              AreaEn = AreaEn - 1
              If FieldCnt < HintVal Then
                AreaEn = FieldPos - 1
                FieldCnt = 0
              End If
            Else
              Exit Do
              FieldCnt = FieldCnt + 1
            End If
            FieldPos = FieldPos - 1
          Loop
  '候補範囲更新
    ....

FieldCntで空白までの領域長をカウントし、空白が現れた時点でFieldCntがヒント値より小さければ空白までを候補範囲から除外すると共にFieldCntをクリアしています。「範囲端の空白」は区切られる領域数ゼロでの範囲縮小に当るので、コードを変更しても今までの機能は損なわれません。

コードが書込めたら分析を実施してみて下さい。こいのぼりが完成します。

パスカウント

ロジックが難しくなってくると、当然ながら何度もループを繰返すようになります。AnalyzeSheetプロシージャのdoループが何回繰返されたかをカウントすることで、ロジックの難易度を推察できそうです。また今後のプログラミングにより、効率的なアルゴリズムを構築できれば、同じ問題でも少ないループカウントで分析が終了するので、プログラムとしての完成度を測ることもできます。

Sub AnalyzeSheet(Optional ByVal CallSwitch As Boolean)
' シート分析
  '＜初期設定＞
  Dim PassCnt As Long                             'パスカウント
  FieldSqr = CLng(FieldWd) * CLng(FieldHt)        'フィールドセル数算出
    ....

    ....
  '＜フィールド分析＞
  PassCnt = 1                                     '分析パスカウンタ初期化
  NonoModule.BlackOutCheck                        '初回塗潰しチェック
  Do
    LpStp1 = False                                '進捗フラグ初期化
    NonoModule.PSSrenewal                         '候補範囲更新
    NonoModule.BlackOutCheck                      '塗潰しチェック
    If Discrep Then                               'エラーチェック
      If ErrorMsg = vbNullString Then _
        ErrorMsg = "分析中にエラーが発生しました"
      Exit Do
    End If
    If MarkedCnt = FieldSqr Then Exit Do
    PassCnt = PassCnt + 1                         'パスカウント
  Loop While LpStp1
  '＜終了表示＞
ExitAnalyzeSheet:
  If Discrep Then                                 '矛盾チェック
    MsgBox ErrorMsg, vbCritical + vbOKOnly, "分析エラー"
  Else
    If MarkedCnt = FieldSqr Then
      MsgBox "分析が終了しました" & vbNewLine _
         & "パスカウント " & CStr(PassCnt), vbOKOnly, "分析終了"
    Else
      MsgBox "分析が終了しませんでした" & vbNewLine _
        & "パスカウント " & CStr(PassCnt) & vbNewLine & "進捗率 " _
        & CStr(Int(MarkedCnt / FieldSqr * 100)) & "%", vbOKOnly, "分析終了"
    End If
  End If
End Sub

プロシージャ冒頭でPassCntを定義します。これをdoループ内でインクリメントし、終了メッセージで表示させます。ちなみにこいのぼりロジックは24回のパスで完成しています。

空白チェック

矛盾点の抽出

ヒント内容更新チェック

右図の例で、ヒント値2の候補範囲は1〜6ですが、その下のように範囲の端部でヒント値を超える連続塗潰しがあった場合はそれが隣以降のヒントに属するものであり、範囲が狭まります。ヒント値を超える連続塗潰しであれば、初期範囲の端だろうが真ン中だろうが、それはこのヒントに属するものではなくなるのですが、範囲中央でそのような連続塗潰しがあった場合、塗潰しブロックの右が新たな範囲なのか、左がそうなのかを判断するために、隣のヒントはどうなっているかをチェックしなければならず、処理が煩雑になります。先々そのような発展型を考えてもイイのですが、ここでは簡単に‘端っこ’であることを条件とします。

Sub PSSrenewal(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新
' ヒント値を上下左右の端点から走査し、以下のチェックを行って候補範囲を縮小する。
' ・候補範囲外から続く連続塗潰しがあれば範囲から除外。
' ・候補範囲端にヒント値を越える連続塗潰しがあれば範囲から除外。
  Dim HintVal As Integer                          '対象ヒント値
    ....

    ....
  'ヒント走査 左→右
      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 CheckBlack(ScanCnt, AreaSt - 1)
              If AreaSt < FieldWd Then
                AreaSt = AreaSt + 1
              Else
                Exit Do
              End If
            Loop
  '候補範囲左端からのヒント値を越える連続塗潰しを除外
            FieldPos = AreaSt                     'FieldPos は塗潰し始点を示す
            Do While CheckBlack(ScanCnt, FieldPos)
              If FieldPos < FieldWd Then
                FieldPos = FieldPos + 1
              Else
                Exit Do
              End If
            Loop
            If FieldPos - AreaSt > HintVal And FieldPos < FieldWd Then _
              AreaSt = FieldPos + 1
          End If
          If AreaEn - AreaSt + 1 >= HintVal Then
    ....

    ....
  'ヒント走査 左←右
      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 CheckBlack(ScanCnt, AreaEn + 1)
              If AreaEn > 1 Then
                AreaEn = AreaEn - 1
              Else
                Exit Do
              End If
            Loop
  '候補範囲右端からのヒント値を越える連続塗潰しを除外
            FieldPos = AreaEn                     'FieldPos は塗潰し終点を示す
            Do While CheckBlack(ScanCnt, FieldPos)
              If FieldPos > 1 Then
                FieldPos = FieldPos - 1
              Else
                Exit Do
              End If
            Loop
            If AreaEn - FieldPos > HintVal And FieldPos > 1 Then _
              AreaEn = FieldPos - 1
          End If
          If AreaEn - AreaSt + 1 >= HintVal 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 CheckBlack(AreaSt - 1, ScanCnt)
              If AreaSt < FieldHt Then
                AreaSt = AreaSt + 1
              Else
                Exit Do
              End If
            Loop
  '候補範囲上端からのヒント値を越える連続塗潰しを除外
            FieldPos = AreaSt                     'FieldPos は塗潰し始点を示す
            Do While CheckBlack(FieldPos, ScanCnt)
              If FieldPos < FieldHt Then
                FieldPos = FieldPos + 1
              Else
                Exit Do
              End If
            Loop
            If FieldPos - AreaSt > HintVal And FieldPos < FieldHt Then _
              AreaSt = FieldPos + 1
          End If
          If AreaEn - AreaSt + 1 >= HintVal Then
    ....

    ....
  'ヒント走査 上←下
      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 CheckBlack(AreaEn + 1, ScanCnt)
              If AreaEn > 1 Then
                AreaEn = AreaEn - 1
              Else
                Exit Do
              End If
            Loop
  '候補範囲下端からのヒント値を越える連続塗潰しを除外
            FieldPos = AreaEn                     'FieldPos は塗潰し終点を示す
            Do While CheckBlack(FieldPos, ScanCnt)
              If FieldPos > 1 Then
                FieldPos = FieldPos - 1
              Else
                Exit Do
              End If
            Loop
            If AreaEn - FieldPos > HintVal And FieldPos > 1 Then _
              AreaEn = FieldPos - 1
          End If
          If AreaEn - AreaSt + 1 >= HintVal Then
    ....

次に、ヒント値と同じ幅の範囲に塗潰しがあっても、そこからヒント値分の範囲に狭まります。またヒント値+1の位置が塗潰しなら、端が空白になり候補範囲も狭くできます。

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