FRIHOST FORUMS SEARCH FAQ TOS BLOGS COMPETITIONS
You are invited to Log in or Register a free Frihost Account!


VB Sudoku solver!





m0u53m4t
Im currently working on it. Ill post when its done. Here's the code so far:
Code:
Private Sub cmdDo_Click(Index As Integer)
Static Solution(1 To 9, 1 To 9) As Variant
Static PossibleValues(1 To 10) As Integer
Static boxres(1 To 9) As Integer
Dim x As Integer
Dim y As Integer
Dim x2 As Integer
Dim y2 As Integer
Dim x3 As Integer
Dim y3 As Integer
Dim xbox As Integer
Dim ybox As Integer
Dim poss As Integer
Dim boxes As Integer
Dim currenthighest As Integer
Dim highestbox As Integer
Dim highestcell As Integer
Dim valcount As Integer
Dim z As Integer
Dim m As Integer
Dim n As Integer
Dim CurrentNo As Integer
Dim currentbox As Integer
Dim answer As Integer
Dim strSQL As String
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim loaded As Integer


Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=MSDASQL.1;Persist Security Info=False;Data Source=Sudoku"
cn.Open

   
Select Case Index
    Case Is = 1: 'Load
    If loaded = 1 Then
    Else
    loaded = 0
    cmdDo(0).Enabled = True
    cmdDo(2).Enabled = True
        adoProblems.Recordset.MoveFirst
        For y = 1 To 9 'For the vertical column
           
            For x = 1 To 9 ' For the horisontal row
           
               Solution(y, x) = PossibleValues()
               For poss = 1 To 10 'Repeat for 123456789
                    If poss = 10 Then
                        Select Case x: 'Writing from table to array
                            Case Is = 1:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col1 & "")
                            Case Is = 2:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col2 & "")
                            Case Is = 3:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col3 & "")
                            Case Is = 4:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col4 & "")
                            Case Is = 5:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col5 & "")
                            Case Is = 6:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col6 & "")
                            Case Is = 7:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col7 & "")
                            Case Is = 8:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col8 & "")
                            Case Is = 9:
                            Solution(y, x)(poss) = Val(adoProblems.Recordset!Col9 & "")
                        End Select
                       
                        If Not Solution(y, x)(10) = 0 Then 'If pos 10 has a value
                            For z = 1 To 9
                                CurrentNo = Solution(y, x)(10)
                                Solution(y, x)(z) = 0              ' Wipe all positions (ex. 10)
                            Next z
                            Solution(y, x)(CurrentNo) = CurrentNo 'Put back right position
                        End If
                    Else
                        Solution(y, x)(poss) = poss ' write poss to position poss
                    End If
               Next poss
            Next x
            adoProblems.Recordset.MoveNext
        Next y
        'Completed one pass through whole grid (filled array)
       
        For y = 1 To 9
       
            For x = 1 To 9
'            If y = 7 And x = 1 Then
'            MsgBox ""
'            End If
            If Solution(y, x)(10) > 0 Then
                CurrentNo = Solution(y, x)(10)
                For y2 = 1 To 9
                    If Not y = y2 Then
                        Solution(y2, x)(CurrentNo) = 0 'Wipe out all occurences in column
                    End If
                Next y2
                For x2 = 1 To 9
                    If Not x = x2 Then
                        Solution(y, x2)(CurrentNo) = 0 'Wipe out all occurences in row
                    End If
                Next x2
               
                If x <= 3 Then xbox = 1
                If x > 3 And x < 7 Then xbox = 2
                If x > 6 Then xbox = 3
                If y <= 3 Then ybox = 1
                If y > 3 And y < 7 Then ybox = 2
                If y > 6 Then ybox = 3 ' Find out which xbox and ybox the cell is in
                   
                For m = 0 To 2
                    For n = 0 To 2
                         Solution((ybox * 3) - n, (xbox * 3) - m)(CurrentNo) = 0
                    Next n
                Next m
                Solution(y, x)(CurrentNo) = CurrentNo
            Else
                CurrentNo = 0
            End If
           
            Next x
        Next y
        End If
       
    Case Is = 0: 'Solve
      For y3 = 1 To 9
           
            For x3 = 1 To 9
            valcount = 0
            answer = 0
                    If Solution(y3, x3)(10) = 0 Then 'Not yet established a value
                        For m = 1 To 9
                            If Solution(y3, x3)(m) = 0 Then
                                valcount = valcount + 1
                            Else
                                answer = Solution(y3, x3)(m)
                            End If
                           
                        Next m
                        If valcount = 8 Then
                            Solution(y3, x3)(10) = answer
                            cn.BeginTrans
                                    strSQL = "Update PROBLEMS " & _
                                                "Set Col" & x3 & " = '" & answer & "' " & _
                                                "Where Row = '" & y3 & "'"
                                    Debug.Print (strSQL)
                                               
                                    cn.Execute strSQL
                           
                            cn.CommitTrans
       
                           
                           
                           
                        For y2 = 1 To 9
                            If y3 = y2 Then
                            Else
                                Solution(y2, x3)(answer) = 0 'Wipe out all occurences in column
                            End If
                        Next y2
                        For x2 = 1 To 9
                            If x3 = x2 Then
                            Else
                                Solution(y3, x2)(answer) = 0 'Wipe out all occurences in row
                            End If
                        Next x2
                       
                        If x3 <= 3 Then xbox = 1
                        If x3 > 3 And x3 < 7 Then xbox = 2
                        If x3 > 6 Then xbox = 3
                        If y3 <= 3 Then ybox = 1
                        If y3 > 3 And y3 < 7 Then ybox = 2
                        If y3 > 6 Then ybox = 3 ' Find out which xbox and ybox the cell is in
                           
                        For m = 0 To 2
                            For n = 0 To 2
                                 Solution((ybox * 3) - n, (xbox * 3) - m)(answer) = 0
                            Next n
                        Next m
                        Solution(y3, x3)(answer) = answer
                                     
                        End If
                    End If
            Next x3
      Next y3
                   


End Select
adoProblems.Refresh
End Sub
LukeakaDanish
Hm...i think i have seen quite a few solvers around - in javascript, java etc...

Two points about them:

1: What on earth is the point? - surely you want a program that makes a sudoku for you to solve rather than one which solves it for you

2: They usually cant solve really difficult sudokus and usually spit out errors for the sudokus where you have to think on many levels at once - which is sometimes a requirement once you get of the beginner stuff...


Ages ago i actually started making one myself in JS, however i left it behind when JS was too slow for my guess_num() function - which was my weapon against the "unsolveables"...perhaps VB will serve you better..


My suggestion is that you use the code you get form building the solver, to make an application which will allow people to create their own sudokus - thereby giving an actual purpose to you app...

Or just ignore me...what do i care Wink
m0u53m4t
Meh. I was bored. When I finnish mine it can solve all sudukos, because of the logical way it works.
LukeakaDanish
When its finnished i will send you a test sudoku then Wink

If it solves that then you have proved me wrong and i will congratulate you Very Happy
m0u53m4t
I almost finnished. The guessing bit was finnished but started playing up... I may debug one day...
Related topics
Reply to topic    Frihost Forum Index -> Scripting -> Others

FRIHOST HOME | FAQ | TOS | ABOUT US | CONTACT US | SITE MAP
© 2005-2011 Frihost, forums powered by phpBB.