このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。
両端詰めのルーチンはできたので、
これらを利用して、共通部分を調べる処理を作る。
これさえできればあと少しのはずだ。
まず、関数のシグネチャを考えてみよう。
Private Function SolveLine( _
ByVal Hints As PuzzleHintCollection, _
ByRef States() As CellStateConstants) As Long
ヒントの値を格納したオブジェクト Hints と、
現在の状態を保存しているセル配列 States を受け取り、
確定できるセルを確定して States に反映し、
戻り値として、確定できたセル数を返す。
矛盾が生じた場合は、-1 を返す。
続いて、処理の内容を考える。
基本は先日作った、PackFront と PackRear を
適切なバッファを用意して呼び出す事だ。
次に、上記の結果を調べて、
前詰め・後ろ詰めのどちらの状態でも
解答として共通している部分を検出し、
その範囲を確定させて States に反映する。
そして最後に確定させた数を返す。
こんな感じだ。では作ってみよう。
まずは変数の定義だ。VBA では、関数内のどこで定義しても、
結果的に関数の先頭に定義されたことになるので、
先頭にまとめて定義しておく習慣がある。
Dim lEnds() As Long
Dim lStarts() As Long
Dim c As Long
Dim h As Long
Dim lDecided As Long
lDecided = 0
ヒントが存在しない場合は、全て空白で確定するはずだ。
States に結果を格納して反映させ、数を数える。
既に CELL_CHECKED の場合は確定済みなので数えない。
CELL_UNSOLVED でなければ（CELL_FILLED ならば）
矛盾が生じているということになる。
If Hints.Count = 0 Then
For c = 0 To UBound(States)
'
If States(c) <> CELL_CHECKED Then
If States(c) = CELL_UNSOLVED Then
States(c) = CELL_CHECKED
lDecided = lDecided + 1
Else
' 矛盾
SolveLine = -1
Exit Function
End If
End If
Next
SolveLine = lDecided
Exit Function
End If
ここからが本番だ。まずは、前詰めを試し、
その際にヒントが占める領域の終端位置を計算する。
ReDim lEnds(0 To Hints.Count - 1)
If PackFront(Hints, States, lEnds) = False Then
' 矛盾
SolveLine = -1
Exit Function
End If
続けて、後ろ詰めを試し、ヒントの先頭位置を計算する。
なお、PackFront で矛盾しなかった場合は、
PackRear でも絶対矛盾しないはずだが、
後で変更したり、バグが混ざったりする事を考えて、
念のため、チェックを追加しておく。
ReDim lStarts(0 To Hints.Count - 1)
If PackRear(Hints, States, lStarts) = False Then
' 矛盾
SolveLine = -1
Exit Function
End If
さて、両方を評価したので、重なる部分を調べる。
前詰めに配置した場合と後ろ詰めに配置した場合に
ヒントが重複する場所は、塗り潰しで確定するはずだ。
例えば、ヒントの長さが 4、前詰めでの終端位置が 5
後ろ詰めでの先頭位置が 3 とすると、以下のようになる。
.0..1..2..3..4..5..6..7..8..9.
＿□◆◆◆◆＿□＿＿（前詰め）
.0..1..2..3..4..5..6..7..8..9.
＿□＿◆◆◆◆□＿＿（後ろ詰め）
この場合、確定するのはこの部分だ。
.0..1..2..3..4..5..6..7..8..9.
＿□＿◆◆◆＿□＿＿（後ろ詰め）
これは、3-5 であり、後ろ詰めでの先頭位置から、
前詰めでの終端位置までの範囲ということになる。
' 重複する塗り潰しセルを確定する
For h = 0 To Hints.Count - 1
For c = lStarts(h) To lEnds(h)
If States(c) = CELL_UNSOLVED Then
States(c) = CELL_FILLED
lDecided = lDecided + 1
End If
Next
Next
SolveLine = lDecided
End Function