帰謬法の実装

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

では、帰謬法の実装をしてみよう。

1 セル確定するまで処理を行うメソッドを作ってみる。

Function SolveLineByRaa( _
        ByVal Hints As PuzzleHintCollection, _
        ByRef States() As CellStateConstants) As Long

    Dim fFilled    As Boolean
    Dim fChecked    As Boolean
    Dim c          As Long

    c = -1
    Do
        c = c + 1

        ' 次の未解決セルを検索し
        Do While c < UBound(States) + 1
            If States(c) = CELL_UNSOLVED Then Exit Do
            c = c + 1
        Loop

        ' これ以上未解決セルがない場合は進まない
        If c > UBound(States) Then
            SolveOneByRaa = 0
            Exit Function
        End If

        ' まずは塗り潰し済みとして矛盾しないかどうか調べる
        States(c) = CELL_FILLED
        fFilled = CheckConsistency(Hints, States)

        ' 続いてチェック済みとして矛盾しないかどうか調べる
        States(c) = CELL_CHECKED
        fChecked = CheckConsistency(Hints, States)

        ' 両方矛盾する場合は絶対解けない
        If fFilled = False And fChecked = False Then
            SolveOneByRaa = -1
            Exit Function
        End If

        ' 仮定を元に戻しておく
        States(c) = CELL_UNSOLVED

        ' どちらでも成立する場合は確定できない
    Loop While fFilled And fChecked

    ' 1 セル確定できた
    If fFilled Then
        States(c) = CELL_FILLED
    Else ' If fChecked Then
        States(c) = CELL_CHECKED
    End If

    SolveOneByRaa = 1
End Function

実装するとこのような感じになる。
シグネチャは、以前のアルゴリズム SolveLine 関数と同じ。

まずは仮定し、その状態で解答があるかどうか調べるのだ。
矛盾の調査には CheckConsistency というヘルパ関数を使う。

CheckConsistency は、以前作った PackFront などを
そのまま流用することが可能だ。

前詰めができれば答えがあるので、矛盾しないと考えられる。
PackFront などが返す第 3 引数は不要なので、
それを除去し、そのまま CheckConsistency として使う。