このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。
では、もう少し掘り下げて実装してみよう。
処理を 1 つの関数として考えてみる。
PackFront という名前にしよう。
入出力となる引数は以下の通りだ。
・現在の状態配列: States（入力）
・ヒントの数値配列: Hints（入力）
・左詰めしたヒントの終端位置配列: Ends（出力）
Function PackFront(ByVal Hints() As PuzzleHintCollection, _
ByRef States() As CellStateConstants, _
ByRef Ends() As Long) As Boolean
Ends はヒントの終端位置を持つ配列だ。
これは別に先頭位置の配列でも良かったのだが、
こういうマッチング処理を行なう場合、
ヒントの後ろから前に向かって調べる方が効率が良いのだ。
まあ、好みの問題かもしれない。
ここでは、Hints を PuzzleHintCollection にしたが、
配列や、配列のように振舞う別のクラスでも構わない。
戻り値は、正常に終了した場合、True、
どこかで矛盾が生じた場合は False だ。
では、流れを考えてみよう。
States と、Hints を元に Ends を求める。
まず、昨日の条件を整理してみよう
1. ヒントが占める範囲が、未確定又は塗り潰し確定である
2. ヒントの左右が塗り潰し確定ではない
3. 最後のヒントよりも後に塗り潰し確定セルがない
4. 前のヒントとの間に塗り潰し確定セルがない
5. 最初のヒントの前に塗り潰し確定セルがない
ヒントの当てはめは、前から後ろに向かって行なうため、
4 や 5 を気にすることは少ないが、3 は非常に重要である。
なので、最も後ろにある塗り潰し確定セルを先に調べ、
後で簡単に検査できるようにしておく。
Dim lLastFilled As Long
For lLastFilled = UBound(States) To 0 Step -1
If States(lLastFilled) = CELL_FILLED Then Exit For
Next
VB のループ変数は、ループが終わった後も値を保持する。
そのため、見つからなかった場合は、lLastFilled は -1 だ。
本当は、States.LastIndexOf(～) などとしたいが、
そのような実装に野心を持つとまた長くなるのでやめておく。
次に、ヒントが存在するかどうかを調べる。
ヒントがない場合は、塗りつぶしセルはないはずなので、
上記で調べた lLastFilled が -1 でないとおかしい。
If Hints.Count = 0 Then
PackFront = lLastFilled < 0
Exit Function
End If
ヒントが存在した場合は、昨日考えた処理を行う。
ヒントは先頭から順に当てはめていくが、
状況によっては、戻ってやりなおす可能性もあるので、
現在調べているヒントの番号をカウンタ変数に格納し、
For ループより、柔軟性のある Do ループを使って、
カウンタ変数を自分で変動させることができるようにする。
Dim h As Long
' 現在着目しているヒント番号。最初は 0 から
h = 0
ここからはループに入る。
Do
ループで最初にやることは、最初の着目位置を決めることだ。
現在着目しているヒントの終端位置は lEnd に入れておき、
条件をみたしているか順に調べていくのだ。
まずは lEnd を最も手前に仮決めしておこう。
最初のヒントの場合、最も前に詰めた位置で、
それ以外の場合、直前のヒントと 1 つ間を空けた直後だ。
仮に、ヒントは 3 2 としよう。
.0..1..2..3..4..5..6..7.
◆◆◆＿●●＿＿
先頭の場合は、最も前に詰めると、0～2 を占有する。
つまり終端位置は 2 だ。これは、ヒント長 - 1 で求まる。
それ以降の場合、直前のヒントと最低 1 つの間を空ける。
例の場合、2 つ目のヒントは、4～5 を占有する。
つまり終端位置は 5 だ。これは、
直前のヒントの終端位置 + 1 + ヒント長で求まる。
Dim lEnd As Long
If h = 0 Then
lEnd = Hints(h) - 1
Else
lEnd = Ends(h - 1) + 1 + Hints(h)
End If
次に、調べるのは条件 3 の処理だ。
最も後ろにある塗り潰し確定セル lLastFilled は、
最低でも最後のヒントの一部となる必要がある。
もし、最後のヒントが lLastFilled よりも手前なら
lLastFilled を含むような位置から調べないといけない。
If h = Hints.Count - 1 Then
If lEnd < lLastFilled Then lEnd = lLastFilled
End If
これで、マッチングの開始位置が求まった。
あとは、順番に当てはめていく。
この場所にラベルをつけておこう。
Match:
まずは、現在の着目位置が範囲を超えてしまったら矛盾だ。
末尾で調べているので、比較文は少し簡単である。
If lEnd > UBound(States) Then Exit Function
そして、条件 2 を調べよう。
後ろに塗りつぶしが連続している場合、
それらも同じヒントに含まれなければならないはずなので、
それらを含むように、着目位置を後ろにずらす。
ずらせなければ、矛盾となる。
Do While lEnd < UBound(States)
If States(lEnd + 1) <> CELL_FILLED Then Exit Do
lEnd = lEnd + 1
Loop
そして、条件 1 を調べる。
プログラム的には、条件 1 がもっとも骨の折れる作業だ。
ヒントの長さだけ調べる必要があるからである。
ヒントの占める部分を順番に調べる手もあるが、
こういったマッチングの場合、
後ろから順に調べると効率がよい。
この場合、範囲内に空白確定セルがあった場合、
絶対にその場所にはマッチしないはずだからだ。
例えば、以下の状態としよう。
.0..1..2..3..4..5..6..7..8..9.
＿＿＿＿□＿＿＿＿
◆◆◆
現在、着目位置 = 4 で、ヒントの長さが 3 の場合、
以下のような状態である。
.0..1..2..3..4..5..6..7..8..9.
＿＿◆◆◇＿＿＿＿
4 の位置の空白確定セルがぶつかっているため、
このヒントは、5～7 より手前に当てはまるはずがない。
つまり、着目位置を 7 まで一気にずらすことができるのだ。
この 7 は、ぶつかった位置 4 にヒント長を足したものだ。
人間の目では明確なことだが、コードで表現する場合、
最も後ろでぶつかった位置の後ろに移動という形式となる。
Dim lStart As Long
Dim c As Long
' 着目点より先頭位置を逆算する
lStart = lEnd - Hints(h) + 1
' 条件 1 により、範囲内に空白確定セルがあれば、
' その後ろから再評価する
For c = lEnd To lStart Step -1
If States(c) = CELL_CHECKED Then
lEnd = c + Hints(h)
GoTo Match
End If
Next
これで、ヒントが当てはまる場所が決まった。
後は、条件 4 や 5 を調べる。
直前のヒントの間に塗り潰し確定セルがあれば、
前のヒント位置がおかしいことになる。
その場合、一つ前のヒントをもう一度調べなおす必要がある。
取り残されていた塗り潰し確定セルは、
最低でも直前のヒントに含まれる必要があるため、
その塗り潰し確定セルを含む位置から再評価する。
例として、◆が直前のヒント、●が現在のヒントとしよう。
.0..1..2..3..4..5..6..7..8..9.
□◆◆◆＿■□●●＿
●は、上記のアルゴリズムで 7～8 で確定したが、
5 の位置に塗り潰し確定セルが残っているため、
条件 4 を満たさない。直前のヒントが間違いということだ。
とりのこされた 5 の位置の塗り潰しは、
最低でも直前のヒントに含まれる必要があるため、
直前のヒントを、5 の位置を着目位置として調べなおす。
.0..1..2..3..4..5..6..7..8..9.
□＿＿◆◆■□＿＿＿
Dim lEndPrev As Long
' 直前のヒントの末尾位置を得る
If h = 0 Then
lEndPrev = -1
Else
lEndPrev = Ends(h - 1)
End If
' 直前のヒントとの間に塗りつぶし確定セルがあれば、
' 前のヒントの位置が間違っていることになる
For c = lStart - 1 To lEndPrev + 1 Step -1
If States(c) = CELL_FILLED Then
' 一つ前のヒントからやり直す
h = h - 1
' もし最初のヒントで合わなければ矛盾している
If h = -1 Then Exit Function
' 間に残っていた塗り潰しは、
' 少なくとも前のヒントに含まれるため、
' その位置からマッチングを再開する
lEnd = c
GoTo Match
End If
Next
この時点で、このヒントとそれ以前のヒントは、
すべての条件を満たしていることになるので、記憶させる。
Ends(h) = lEnd
そして、次のヒントの評価に進む。
すべてのヒントが決定すれば、左詰めは完了だ。
If h = Hints.Count - 1 Then Exit Do
' 次のヒントへ
h = h + 1
Loop
PackFront = True
End Function
結構長い関数となった。最適化の余地はありそうだ。