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

例1102 例1103 例1103

ここまでは「塗潰し」から候補範囲を狭める作業をしてきましたが、「空白」も候補範囲更新にとっては重要な情報で、例えば候補範囲の端が空白ならその分範囲を小さくすることができます。ここから候補範囲の更新は、空白を見付ける操作と並行して進めて行きます。例えば右図でヒント値2の初期状態における塗潰し候補範囲は1〜6、ヒント値3については4〜10ですが、図のように空白が確定すると、候補範囲はそれぞれ1〜4、6〜10に狭まり、ヒント値3に関しては右から8番目のマスで塗潰しが確定します。

ヒントのない列は全空白

実際のお絵かきロジックではなかなかお目にかかりませんが、ヒントが全くないラインがあった場合、そこは1列全部が空白です。ヒントのない列を持つロジックというのは、自分も過去に1回しか遭遇したことはありませんが、現実にゼロというわけではないので、一応対応しておきます。 


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

    ....
  '＜ヒント合計チェック＞
  If HintSumHrz <> HintSumVrt Then
    Discrep = True
    ErrorMsg = "水平ヒントの合計と垂直ヒントの合計とが" _
      & vbNewLine & "一致しません。"
    GoTo ExitAnalyzeSheet
  End If
  '＜ヒント無ライン空白確定＞
  For ScanCnt = 1 To FieldHt                      '水平ヒント無ライン空白確定
    If HintCntHrz(ScanCnt) = 0 Then
      For FieldCnt = 1 To FieldWd
        If Not (CheckWhite(ScanCnt, FieldCnt)) Then _
          NonoModule.PutWhite ScanCnt, FieldCnt
      Next FieldCnt
    End If
  Next ScanCnt
  For ScanCnt = 1 To FieldWd                      '垂直ヒント無ライン空白確定
    If HintCntVrt(ScanCnt) = 0 Then
      For FieldCnt = 1 To FieldHt
        If Not (CheckWhite(FieldCnt, ScanCnt)) Then _
          NonoModule.PutWhite FieldCnt, ScanCnt
      Next FieldCnt
    End If
  Next ScanCnt
  '＜フィールド分析＞
  NonoModule.BlackOutCheck                        '初回塗潰しチェック
  Do
    ....

プログラムsepとしては非常に単純であり、説明の必要はないでしょう。予め準備しておいたCheckWhiteファンクションプロシージャとPutWhiteサブプロシージャをここでやっと使うことができました。

それでは続けてヒント値と所属塗潰しの長さが一致して、塗潰しブロックが確定した場合に、その両脇を空白にするコード追加をしてみます。 


Sub BlackOutCheck(Optional ByVal CallSwitch As Boolean)
' 塗潰しチェック
' ヒント値が候補範囲の１／２を越える場合、中央部塗潰が確定する。ヒント値と候補範
' 囲が等しければ塗潰ブロックが確定する。
  Dim BlockStr As Integer                         'ブロック始点
  Dim BlockEnd As Integer                         'ブロック終点
  Dim BlockLen As Integer                         'ブロック長
  Dim HintVal As Integer                          '対象ヒント値
  '＜水平方向スキャン＞
    ....

    ....
      If HintVal > BlockLen / 2 Then              '黒塗潰あり
        For FieldCnt = BlockEnd - HintVal + 1 To BlockStr + HintVal - 1
          If Not CheckBlack(ScanCnt, FieldCnt) Then
            NonoModule.PutBlack ScanCnt, FieldCnt
          End If
        Next FieldCnt
        If HintVal = BlockLen Then                'ブロック確定
          If BlockStr > 1 Then                    '両端に空白設置
            If Not CheckWhite(ScanCnt, BlockStr - 1) Then
              NonoModule.PutWhite ScanCnt, BlockStr - 1
            End If
          End If
          If BlockEnd < FieldWd Then
            If Not CheckWhite(ScanCnt, BlockEnd + 1) Then
              NonoModule.PutWhite ScanCnt, BlockEnd + 1
            End If
          End If
        End If
      End If
    Next HintCnt
    If Discrep Then Exit For
  Next ScanCnt
  If Discrep Then Exit Sub
  '＜垂直方向スキャン＞
    ....

    ....
      If HintVal > BlockLen / 2 Then              '黒塗潰あり
        For FieldCnt = BlockEnd - HintVal + 1 To BlockStr + HintVal - 1
          If Not CheckBlack(FieldCnt, ScanCnt) Then
            NonoModule.PutBlack FieldCnt, ScanCnt
          End If
        Next FieldCnt
        If HintVal = BlockLen Then                'ブロック確定
          If BlockStr > 1 Then                    '両端に空白設置
            If Not CheckWhite(BlockStr - 1, ScanCnt) Then
              NonoModule.PutWhite BlockStr - 1, ScanCnt
            End If
          End If
          If BlockEnd < FieldHt Then
            If Not CheckWhite(BlockEnd + 1, ScanCnt) Then
              NonoModule.PutWhite BlockEnd + 1, ScanCnt
            End If
          End If
        End If
      End If
    Next HintCnt
    If Discrep Then Exit For
  Next ScanCnt
End Sub
空白設置

各フィールドの端部以外であれば空白を設置するようにしました。これで‘A’の横棒が決定します。ここまで進むと、一番下の水平ラインで左右端が塗潰しになることが解ります。そのためには候補範囲更新で「空白部分も範囲から除外」する必要があり、次節で対応して行きます。またこれによって左右端の垂直ラインでヒント値3が確定するので、その上が空白になります。更に進むと、上から2番目の水平ラインも2つの塗潰しが確定し、それによって最上段が空白で狭まって、ロジック完成となります。なんだか一気に分析終了が見えてきましたね。

塗潰し補範囲更新 その3

それでは空白でも候補範囲が更新されるようにしてみます。候補範囲の端点に空白を発見すると範囲を1マス分狭めるDoループです。 


Sub PSSrenewal(Optional ByVal CallSwitch As Boolean)
' 候補範囲更新
' ヒント値を上下左右の端点から走査し、以下のチェックを行って候補範囲を縮小する。
' ・候補範囲外から続く連続塗潰しがあれば範囲から除外。
' ・単独ヒント配属または未解決端の塗潰し検出時は範囲更新。
' ・候補範囲端に空白があれば範囲から除外。
  Dim HintVal As Integer                          '対象ヒント値
    ....

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

    ....
          If AreaEn > BlockEn Then AreaEn = BlockEn
  '候補範囲左端の空白を除外
          Do While CheckWhite(ScanCnt, AreaSt)
            If AreaSt < FieldWd Then
              AreaSt = AreaSt + 1
            Else
              Exit Do
            End If
          Loop
  '候補範囲更新
    ....

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

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

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

    ....
          If AreaEn > BlockEn Then AreaEn = BlockEn
  '候補範囲上端の空白を除外
          Do While CheckWhite(AreaSt, ScanCnt)
            If AreaSt < FieldHt Then
              AreaSt = AreaSt + 1
            Else
              Exit Do
            End If
          Loop
  '候補範囲更新
    ....

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

    ....
          If AreaSt < BlockSt Then AreaSt = BlockSt
  '候補範囲下端の空白を除外
          Do While CheckWhite(AreaEn, ScanCnt)
            If AreaEn > 1 Then
              AreaEn = AreaEn - 1
            Else
              Exit Do
            End If
          Loop
  '候補範囲更新
    ....
空白による範囲更新

分析を実行すると左図のような結果になります。空白による範囲更新で一番下の水平ラインが進展し、両脇の垂直ラインでヒント値3が確定するまで進んでいます。イミディエイトウィンドウを見てみると、全体で5回ループしていることが確認でき、分析が前進していることが解ります。

配属先のないマスは空白

全ヒント解決ラインの空白

ここまでの結果を見ていると、右図のように右上角と左上角が空白であることは明らかです。左右端の縦ラインはヒント値3が総て決まったので、残りは空白ということになります。「全ヒントが解決したラインの未定マスは空白にする」という方法をすぐに思いつきますが、ちょっと見方を変えてみましょう。空白になるべき角部は“垂直スキャンにおいて、どのヒントにも属さないマス”という捉え方ができます。配属先ヒント番号取得を行うSetAttachedHintプロシージャ内で「どこにも属さないヒントは空白」という操作を行えば、既存のプロシージャ内で処理が可能な上、全ヒントが決定しなくても、配属先のないマスは空白確定となり、カバーできる範囲が広がります。 


Sub SetAttachedHint(ByVal HrzFlg As Boolean, ByVal LinePos As Integer)
' 配属先ヒント番号取得
' フィールドが属するヒント番号を取得する。単独配属ならヒント番号、重複して配属す
' る場合は負数が格納される。またフィールドが属するヒント値の最大値や最小値（単独
' 配属なら属するヒント値そのもの）等も同時に取得する。
' 配属先ヒント値取得と平行して配属先ヒントがないフィールドは空白設置を行う。
  Dim HintEnd As Byte                             'ライン内ヒント数
    ....

    ....
        HintAttch(FieldCnt) = -1                  '重複部：負数
      Else
        HintAttch(FieldCnt) = HintNum(FieldCnt)   '単独配属：ヒント番号
        If HintAttch(FieldCnt) = 0 Then           '配属先無 → 空白
          If HrzFlg Then
            If Not CheckWhite(LinePos, FieldCnt) Then
              LpStp1 = True                       '進展チェック
              NonoModule.PutWhite LinePos, FieldCnt
            End If
          Else
            If Not CheckWhite(FieldCnt, LinePos) Then
              LpStp1 = True                       '進展チェック
              NonoModule.PutWhite FieldCnt, LinePos
            End If
          End If
        End If
      End If
    Next FieldCnt
  End If
End Sub

空白による範囲更新がうまく進み、ずいぶんと解決に近付きました。ここまで来ると上から2番目の水平ラインで2つのヒントが決定し、空白が決まることで最上段の候補範囲がヒント値に等しくなり、分析が終了するストーリーが見えてきます。

塗潰し補範囲更新 その4

2行目水平ライン

上から2列目の水平ラインは3マス残ったところにヒント値‘1’が2つ入るので、両端が塗潰しで真ん中が空白になります。イミディエイトウィンドウで候補範囲更新の進展具合を見てみると、左側の‘1’は「2〜3」、右側の‘1’は「3〜4」となっており、カブっている3マス目を除外できていないことが解ります。左から2マス目が左側の‘1’により塗潰しだったと考えると、右側ヒントの候補範囲開始点が4マス目になるのは「候補範囲始点からヒント値+空白(必ず1つ以上)が次のヒントの候補範囲始点」であるという理屈に基づきます。つまり一番詰込んだ状態を計算して候補範囲を更新できるというコトです。実はこの範囲更新は最も基本的な処理内容で、紙と鉛筆でロジックを解いているときも、誰もが端からマスを数えて塗潰せる範囲を探しているはずです。 


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

    ....
  'ヒント走査 左→右
      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     '未解決左端ヒントは対象外
  '先行候補範囲から始点更新
            FieldPos = PssStHrz(ScanCnt, HintCnt - 1) _
              + HintHrz(ScanCnt, HintCnt - 1) + 1
            If FieldPos > AreaSt And FieldPos <= FieldWd Then AreaSt = FieldPos
  '候補範囲左端以前からの連続塗潰しを除外
            Do While CheckBlack(ScanCnt, AreaSt - 1)
    ....

    ....
  'ヒント走査 左←右
      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     '未解決右端ヒントは対象外
  '後続候補範囲から終点更新
            FieldPos = PssEnHrz(ScanCnt, HintCnt + 1) _
              - HintHrz(ScanCnt, HintCnt + 1) - 1
            If FieldPos < AreaEn And FieldPos >= 1 Then AreaEn = FieldPos
  '候補範囲右端以降からの連続塗潰しを除外
            Do While CheckBlack(ScanCnt, AreaEn + 1)
    ....

    ....
  'ヒント走査 上→下
      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     '未解決上端ヒントは対象外
  '先行候補範囲から始点更新
            FieldPos = PssStVrt(ScanCnt, HintCnt - 1) _
              + HintVrt(ScanCnt, HintCnt - 1) + 1
            If FieldPos > AreaSt And FieldPos <= FieldHt Then AreaSt = FieldPos
  '候補範囲上端以前からの連続塗潰しを除外
            Do While CheckBlack(AreaSt - 1, ScanCnt)
    ....

    ....
  'ヒント走査 上←下
      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     '未解決下端ヒントは対象外
  '後続候補範囲から終点更新
            FieldPos = PssEnVrt(ScanCnt, HintCnt + 1) _
              - HintVrt(ScanCnt, HintCnt + 1) - 1
            If FieldPos < AreaEn And FieldPos >= 1 Then AreaEn = FieldPos
  '候補範囲下端以降からの連続塗潰しを除外
            Do While CheckBlack(AreaEn + 1, ScanCnt)
    ....

これで分析を実行すると、アルファベットの‘A’が現れ、分析終了します。この程度の簡単なロジックを解くのにも、ここまでの労力が必要で、これからどんどん難しくなっていくことを考えると、まだ先は長いことを予感させます。

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