数独をＶＢＡで解いてみる ③

昨日は、数独をＶＢＡで解くコードを作成してみた。
infoment.hatenablog.com
まずは基本的ロジックを押さえ、入門レベルであれば解けるところまで作成した。
そこで本日は、昨日の内容について、更にロジックを追加してみる。

昨日は、指定マスについて行列および３×３の範囲を対象に、既に使用されている数字が無いか確認することで、同マスで取りうる値を絞り込んでいった。

しかしこれでは、早晩手詰まりとなる。そこで今回は更に、上記以外のマスでの使用状況から絞り込むロジックを追加する。

例えば、↓ のような場合。

ここに５があることから、

この３マスを含めた空白マスに、５は入り得ない。

従って、９列目で見た場合、５が入りうるのは５，７行目のいずれかとなる。

この理屈で以って、指定セルについて

1. 入る数値が確定する　　⇒　その数値を返す
2. 入る数値が確定しない　⇒　０を返す

という関数を作成してみた。

クラスモジュール（Sudoku）

Private Function GetNumber(r_target, c_target, index) As Long

    Dim r As Long
    Dim c As Long
    Dim v(1 To 9) As Variant
    
    ' 行方向確認。
    ' 各マスの指定数を配列に格納。
        For c = 1 To 9
            v(c) = Mid(ArrAll(r_target, c), index + 1, 1)
        Next
    
    ' 指定マス指定数のフラグが２（＝未確定）であって、且つ
    ' 配列内の０の数が８であれば、そのマスの値はindexで確定する。
        If CountNumber(v, 0) = 8 And v(c_target) = 2 Then
            GetNumber = index
            Exit Function
        End If
        
    ' 列方向確認。以下、同様。
        For r = 1 To 9
            v(r) = Mid(ArrAll(r, c_target), index + 1, 1)
        Next
        
        If CountNumber(v, 0) = 8 And v(r_target) = 2 Then
            GetNumber = index
            Exit Function
        End If
        
    ' ３×３範囲確認。
    Dim sr As Long
        sr = WorksheetFunction.RoundUp(r_target / 3, 0) * 3 - 2
    Dim sc As Long
        sc = WorksheetFunction.RoundUp(c_target / 3, 0) * 3 - 2
    Dim i As Long
        i = 1
        For r = sr To sr + 2
            For c = sc To sc + 2
                v(i) = Mid(ArrAll(r, c), index + 1, 1)
                i = i + 1
            Next
        Next
    Dim myIndex As Long
        myIndex = (r_target - sr) * 3 + (c_target - sc) + 1
    
        If CountNumber(v, 0) = 8 And v(myIndex) = 2 Then
            GetNumber = index
        End If

End Function

なお、これに合わせて配列内における指定値の個数を返すユーザー定義関数も一部修正した。

Private Function CountNumber(arr As Variant, target_number As Long) As Long
    Dim i As Long
    Dim counter As Long
        For i = 1 To 9
            If arr(i) = target_number Then
                counter = counter + 1
            End If
        Next
        
        CountNumber = counter
End Function

最後に、これを作成済み解析ロジックに追加する。

Private Sub CheckNumber(r_target As Long, c_target As Long)
    ' 確定マスの場合、処理終了。
    If Left(ArrAll(r_target, c_target), 1) = 1 Then Exit Sub
    
    Dim r As Long
    Dim c As Long
    Dim v(9) As Variant
    Dim i As Long
    
        ' 各桁置き換え用に、一旦配列化する。
        For i = 0 To 9
            v(i) = Mid(ArrAll(r_target, c_target), i + 1, 1)
        Next
        
    
    ' 行方向確認。
    Dim index As Long
        For c = 1 To 9
            index = ArrNum(r_target, c)
            If index <> 0 Then
                v(index) = 0
            End If
        Next
        
    ' 列方向確認。
        For r = 1 To 9
            index = ArrNum(r, c_target)
            If index <> 0 Then
                v(index) = 0
            End If
        Next
    
    ' ３×３範囲確認。
    Dim sr As Long
        sr = WorksheetFunction.RoundUp(r_target / 3, 0) * 3 - 2
    Dim sc As Long
        sc = WorksheetFunction.RoundUp(c_target / 3, 0) * 3 - 2
        For r = sr To sr + 2
            For c = sc To sc + 2
                index = ArrNum(r, c)
                If index <> 0 Then
                    v(index) = 0
                End If
            Next
        Next
        
        ' ０の数が８個ならば、残った数で確定。
        If CountNumber(v, 0) = 8 Then
            v(0) = 1
            For i = 1 To 9
                If v(i) <> 0 Then
                    v(i) = 1
                    Exit For
                End If
            Next
            ArrNum(r_target, c_target) = i
        
        ' ↓ 今回の追加個所。
        Else
            Dim j As Long
                For j = 1 To 9
                    If GetNumber(r_target, c_target, j) <> 0 Then
                        For i = 0 To 9
                            Select Case i
                                Case 0: v(i) = 1
                                Case j: v(i) = 1
                                Case Else: v(i) = 0
                            End Select
                        Next
                        ArrNum(r_target, c_target) = j
                        Exit For
                    End If
                Next
        End If
        
        ArrAll(r_target, c_target) = Join(v, vbNullString)
End Sub

この結果、昨日の「入門編」から少し前進して、「初級編」までであればクリアできるようになった。しかし、まだまだ先は長い。

ということで、明日に続きます。

参考まで。