数独（再挑戦）③ 確定マスの情報を、行と列全体に反映させる

昨日は数独の出題を、２７×２７の配列に反映してみた。
infoment.hatenablog.com

今日は、確定マスの情報を、行と列全体に反映させてみる。

例えば下記のように、黄色のマスが「３」で確定している場合。

このとき、同じ行にある「緑で塗りつぶされた３」は、既に可能性を絶たれているため、「０」に上書きする必要がある。

そのためにまず、９行９列における任意の指定マスの確定値を取得する関数を作成する。例えば、↓ の出題に於いて、ｆ（３，２）の戻り値が７になる関数だ。
※未確定の場合、戻り値は０とする。

' ９×９の任意セルの数値が確定している場合、その数値を返す。
' 確定していない場合は０を返す。
Private Function FixedNumber(r_index As Long, c_index As Long) As Long
    Dim arr As Variant
        arr = DetailArray(r_index, c_index)
        ' ０の数を数えることで、確定しているか否かを判別する。
        If ArrayCountIF(arr, 0) = 8 Then
            ' 確定値以外は０なので、３×３の範囲の和で求まる。
            FixedNumber = WorksheetFunction.Sum(arr)
        Else
            FixedNumber = 0
        End If
End Function

' ９×９の任意のセルを、２７×２７の配列から抜き出す関数。
Private Function DetailArray(r_index As Long, c_index As Long)
    ' 原点を取得。
    r0 = OriginPoint(r_index, c_index)(OriginIndex.OriginR)
    c0 = OriginPoint(r_index, c_index)(OriginIndex.OriginC)
        
    Dim arr(1 To 3, 1 To 3) As Variant
    Dim r As Long
    Dim c As Long
        For r = 1 To 3
            For c = 1 To 3
                arr(r, c) = TempArray(r0 + r, c0 + c)
            Next
        Next
        
        DetailArray = arr
End Function

' CountIFの配列版。
' 指定配列内の指定値を数えて返している。
Private Function ArrayCountIF(source_array As Variant, _
                              search_criteria As Variant) As Long
    Dim counter As Long
    Dim a As Variant
        On Error Resume Next
        For Each a In source_array
            If a = search_criteria Then
                counter = counter + 1
            End If
        Next
        On Error GoTo 0
        
        ArrayCountIF = counter
End Function

次に必要なのが、９×９の位置と確定値を引数として、その行と列、更には３×３のエリアから確定値を除去する関数だ。例えば一番左上（黄色）が「３」で確定しているなら、太い赤枠で囲った領域の「３」（緑色」を０にする関数。

今回は取り掛かりなので、まず行方向（横方向）で試しに作成してみる。

Private Sub DeleteNumber(r_index As Long, _
                         c_index As Long, _
                         delete_number As Long)
    Dim r As Long
    Dim c As Long
    
    ' 行方向。
        r0 = OriginPoint(r_index, c_index)(OriginIndex.OriginR)
        For r = 1 To 3
            For c = 1 To 27
                If TempArray(r0 + r, c) = delete_number Then
                    If WorksheetFunction.RoundUp(c / 3, 0) <> c_index Then
                        TempArray(r0 + r, c) = 0
                    End If
                End If
            Next
        Next
End Sub

最後に、これを実行するのがこちら。

Public Sub UpdateArray()
    Dim r As Long
    Dim c As Long
    Dim n As Long
    Dim SumAll As Long
    Dim counter As Long
    
        ' 編集の有無を確認するために、予め配列の合計値を求めておく。
        ' ※何らかの編集があれば、１以上の値が０に置き換わり、合計も変わる。
        SumAll = WorksheetFunction.Sum(TempArray)
        
        ' 編集の前後で合計値の差が無くなるまで、つまり何も置き換わらなくなる
        ' まで繰り返す。
        Do
            For r = 1 To 9
                For c = 1 To 9
                    n = FixedNumber(r, c)
                    If n <> 0 Then
                        DeleteNumber r, c, n
                    End If
                Next
            Next
            
            If SumAll = WorksheetFunction.Sum(TempArray) Then
                Exit Do
            Else
                SumAll = WorksheetFunction.Sum(TempArray)
            End If
            
            ' 念のため、仮の措置として、３０回繰り返したらループを抜ける。
            counter = counter + 1
            If counter >= 30 Then Exit Do
        Loop
End Sub

それでは、確認してみよう。

Sub test()
    Dim Sudoku As New Sudoku
        Sudoku.SourceArray = Sheet1.Range("A1:I9").Value
        Sudoku.InitArray
        Sudoku.UpdateArray

        ' 結果確認のため、仮で貼り付け。
        Sheet2.Range("A1").Resize(27, 27) = Sudoku.TempArray
End Sub

結果、先程の例で言えば、行方向の３（緑色）を０に置き換えることが出来た。

明日に続きます。

参考まで。