| dodo
| | Joined: 11 Jul 2005 | | Posts: 5 | | : | |
Items |
|
 Posted: Mon Jul 11, 2005 11:13 pm Post subject: Yet another VB code - is this a brute force approach? |
 |
|
Hi all,
I just wrote a quick'n'dirty approach (as quick'n'dirty as a Visual Basic program with an appalling interface).
Would this be considered a brute force approach? Cheating? Devil invocation?
The implemented algorithm is:
A) The board is represented using sets (bitmaps): one per row, one per column, and one per 3x3 square.
B) Each set holds the remaining values (values not yet used) for each row, column, or 3x3 square.
C) Therefore, allowed values for a particular cell come from the intersection (bitwise AND) of the corresponding three sets (its row's set, its column's set, and its 3x3 square's set).
D) At each turn, the program chooses the cell with a minimal count of allowed values (least 1-bits in the intersection bitmap). If it is zero, there are no solutions (on the current recursion path - see E). If it is one, this is a forced move.
E) If the cell with the minimal count of allowed values has a count greater than 1, succesive solutions are tested, backtracking on further failure.
Solutions for easy problems are usually found without backtracking, and hard problems usually won't backtrack more that 5-15 times. Really hard (or deliberately misleading) pathological cases might backtrack more - currently I've found only one 'outsider', which backtracks 310 times and takes about a second to be solved; namely, one from thread http://www.setbb.com/phpbb/viewtopic.php?t=59&start=0&postdays=0&postorder=asc&highlight=&mforum=sudoku , second post (Simes, Sun Jun 19, 2005 9:12 am), first problem of five.
Code for the main solving routine is shown below. I can post a link to the full source, if you're willing to cope with the yucky interface, and if you give me some time to translate labels and variable names from Spanish  . Though I'm bound to believe this is more or less what everybody's solver is doing.
| Code: |
Private Sub cmdSolve_Click()
InitializeBitmaps
If Not Solution() Then
MsgBox "No solution."
End If
End Sub
'-------------------------------------------
Private Function Solution() As Boolean
Dim cell As Integer
Dim value As Integer
Dim countOfValues As Integer
Dim loopBitmap As Integer
Dim n As Integer
Dim i As Integer
Dim j As Integer
countOfValues = NextMove(cell, i, j) 'recalcs all intersection bitmaps (bmpCells)
'and chooses a cell with lowest countOfValues
Select Case countOfValues
Case -1
Solution = True 'no more empty cells to fill - solution found
Case 0
Solution = False 'cell with no solution - this path fails
Case 1
value = ExtractDigit(bmpCells(cell)) 'remove one element from intersection set
DoMark cell, i, j, value 'update move on row,col,3x3 bitmaps
If Solution() Then
Solution = True
Exit Function
End If
UnMark cell, i, j, value 'take move back on bitmaps
Solution = False
Case Else
loopBitmap = bmpCells(cell) 'set of candidate values
For n = 1 To countOfValues
value = ExtractDigit(loopBitmap) 'remove next element from set
DoMark cell, i, j, value 'update move
If Solution() Then
Solution = True
Exit Function
End If
UnMark cell, i, j, value 'take move back
If n < countOfValues Then
IncrementAndShowBacktrackCount
End If
Next
Solution = False
End Select
End Function |
|
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in
Log in to check your private messages
