2006 年 5 月 22 日 19 時 53 分

右詰めの実装


このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。


右詰めは、左詰めと同じような考えでいける。
左からではなく右から考えていけばよいのだ。

左詰めの実装を逆方向にして実装する方法もあるが、
引数を完全に左右逆転して呼び出す方法もある。

後者の方がスマートで、アルゴリズムの保守性に優れるが、
今回は昨日の整理も兼ねて、左右逆転の実装をしてみよう。

' 指定した解答状況に対してヒントを後ろ詰めに適用した場合、
' 各ヒントが占める先頭位置を取得する。
' 矛盾があれば False を返す
Private Function PackRear(ByVal Hints As PuzzleHintCollection, _
        ByRef States() As CellStateConstants, _
        ByRef Starts() As Long) As Boolean
    Dim lFirstFilled    As Long
    Dim lStart          As Long
    Dim lEnd            As Long
    Dim lStartNext      As Long
    Dim h               As Long
    Dim c               As Long
   
    ' 基本は前詰めと同じ。左右逆転して考えればよい。
   
    ' 条件 3 用に、最も前方に存在する塗り潰し確定セルを検索する
    For lFirstFilled = 0 To UBound(States)
        If States(lFirstFilled) = CELL_FILLED Then Exit For
    Next

    ' ヒントがない場合は即確定だが、塗り潰しセルがあれば矛盾
    If Hints.Count = 0 Then
        PackRear = lFirstFilled >= Hints.Count
        Exit Function
    End If

    ' 現在処理しているヒント番号
    h = Hints.Count - 1
   
    ' ヒントごとの処理
    Do
       
        ' ヒントのマッチングの開始位置を決める
       
        If h = Hints.Count - 1 Then
            ' 末尾の場合、最も後ろに詰めた状態
            lStart = UBound(States) - Hints(h) + 1
        Else
            ' それ以外の場合、直後のヒントのすぐ前
            lStart = Starts(h + 1) - 1 - Hints(h)
        End If
       
        If h = 0 Then
            ' 最初のヒントの場合、条件 3 により、
            ' 最も前方に存在する塗り潰し確定セルは、
            ' 最低でも最初のヒントに含まれなければならない
            If lStart > lFirstFilled Then lStart = lFirstFilled
        End If
       
Match:
        ' ヒントが当てはまる場所を順に探す
       
        ' 着目位置が範囲を超えてしまったら矛盾
        If lStart < 0 Then Exit Function

        ' 条件 2 より、左に塗り潰しが連続している場合、
        ' それらも同じヒントに含まれなければならない
        Do While lStart > 0
            If States(lStart - 1) <> CELL_FILLED Then Exit Do
            lStart = lStart - 1
        Loop
       
        ' 着目位置より末尾位置を逆算する
        lEnd = lStart + Hints(h) - 1

        ' 条件 1 により、範囲内に空白確定セルがあれば、その前から再評価する
        For c = lStart To lEnd
            If States(c) = CELL_CHECKED Then
                lStart = c - Hints(h)
                GoTo Match
            End If
        Next

        ' 条件 4, 5 を調べる
       
        ' 直後のヒントの先頭位置を得る
        If h = Hints.Count - 1 Then
            lStartNext = UBound(States) + 1
        Else
            lStartNext = Starts(h + 1)
        End If

        ' 直後のヒントとの間に塗り潰し確定セルがあれば、
        ' 後ろのヒントの位置が間違っていることになる
        For c = lEnd + 1 To lStartNext - 1
            If States(c) = CELL_FILLED Then

                ' 一つ後のセルからやり直す
                h = h + 1

                ' もし最後のヒントで合わなければ矛盾している
                If h = Hints.Count Then Exit Function

                ' 間に残っていた塗り潰しは、
                ' 少なくとも後のヒントに含まれるため、
                ' その位置からマッチングをはじめる
                lStart = c

                GoTo Match

            End If
        Next
           
        ' 条件を満たしているので、ヒントを現在位置で確定する
        Starts(h) = lStart

        ' 最初のヒントも確定すれば OK
        If h = 0 Then Exit Do
       
        ' 前のヒントへ
        h = h - 1
   
    Loop
   
    PackRear = True
End Function



Copyright (c) 1994-2007 Project Loafer. All rights reserved.