Sudoku Collaboration Project: Source code

To make it clear from the beginning...
This thread is only for source code. No discussion.
This makes things easier for everyone.

1. Post your source code here.
2. Only use one post for your source code.
3. You may describe your code and it's features etc. in your post.
4. If you have anything to comment, do it at the collaboration discussion thread.

The latest version of the core collaboration project is included here. If you do changes to the project and you wish to see them in the "official" version, you may attach it in your post here or send it via private message to me.

Remember that you are free to improve any part of the project. There are three main parts where you can put your interest into:

• The core project: interface, file loading/saving, manual solving, etc.
• Solver modules.
• Generator modules.

It is up to you how you do your solver or generator module or how you construct your functions.

Including a solver module
You must provide a wrapper code that is used to make your code work with the core project. This is a function that is to be added into clsCodeWrapper. Add this into your post when you post your source code (prefer using the code tag over highlight tag).

Also check Form_Load on how to make the core project to know about your function.

Including a generator module
Currently there is no way to add a generator module into the project. This is because I believe there is a need for giving input parameters for generators, thus there is a need for more definition on how they should work. My initial thoughts are that they would be class modules that have certain features to make it possible for the core to know what the generator class supports.


If anything is unclear or you have suggestions, pm me or post in to the collaboration discussion thread.


Update revision: 1

• Fixed SudokuStringToByteArray and SudokuByteArrayToString.
• Included my own brute force solver as a sample.
• Included a solution counter.

Edit 17/7/7: DairyLogic updated to handle Naked/Hidden Pairs/Tripples
Edit 4/7/7: Beta solver code added, DairyLogic (module attached)

clsCodeWrapper: Updated 17/7/7

Code:

---

Public Function DairyLogic(ByRef SudokuBoard As String) As String
    Dim lngOut() As Long
    lngOut = SudokuStringToLongArray(SudokuBoard)
    MilkSolve lngOut
    DairyLogic = SudokuLongArrayToString(lngOut)
End Function

---

Helper Routines: Updated 17/7/7
Two possible routines for ModHelpers, a board dump showing possible solutions (designed for Tahoma bold), and a simple sub to invert bits of a long array (so it could store possible or impossible). I'm using the board dump on a blank form I've inserted into the project to help me decide how to code the next logical step. Feel free not to use them if you don't think they a relevant, feel free to rewrite them if you don't like the code.

vb Code:

'example usage
DumpBoard FrmDebug, PossibleBits() , , 100, 100
'Or
DumpBoard PicDebug, InvertSudokuBits(ImpossibleBits())

Code:

---

Public Sub DumpBoard(TgtObject As Object, _
                    SudokuBoard() As Long, _
                    Optional ByVal BoardSize As Long = -1, _
                    Optional ByVal XOffset As Long = 0, _
                    Optional ByVal YOffset As Long = 0)
'draws a board showing possible solutions
Dim i As Long, ii As Long, UnitSize As Long, YAdjust As Long, XAdjust As Long
With TgtObject
  If BoardSize < 1 Then
    If .ScaleWidth + XOffset > .ScaleHeight + YOffset Then
      BoardSize = .ScaleHeight - YOffset
    Else
      BoardSize = .ScaleWidth - XOffset
    End If
  End If
  UnitSize = BoardSize \ 9
  YAdjust = UnitSize \ 30
  XAdjust = UnitSize \ 30
  TgtObject.Cls
  'draw grid
  For i = 0 To 9
    Select Case i Mod 3
    Case 0: .DrawWidth = 2
    Case 1: .DrawWidth = 1
    End Select
    TgtObject.Line (0 + XOffset, i * UnitSize + YOffset)-Step(BoardSize, 0)
    TgtObject.Line (i * UnitSize + XOffset, YOffset)-Step(0, BoardSize)
  Next i
  'draw solved
  .FontSize = UnitSize / 24
  For i = 0 To 80
    If BITCOUNT(SudokuBoard(i)) = 1 Then
      .CurrentY = (i \ 9) * UnitSize - YAdjust + YOffset
      .CurrentX = (i Mod 9) * UnitSize - XAdjust + XOffset
      TgtObject.Print BITNUMBER(SudokuBoard(i))
    End If
  Next i
  'draw possible
  .FontSize = UnitSize / 70
  For i = 0 To 80
    If BITCOUNT(SudokuBoard(i)) <> 1 Then
      For ii = 1 To 9
        If SudokuBoard(i) And BITTABLE(ii) Then
          XAdjust = ((ii - 1) Mod 3) * (UnitSize / 3)
          YAdjust = ((ii - 1) \ 3) * (UnitSize / 3)
          .CurrentY = (i \ 9) * UnitSize + YAdjust + YOffset
          .CurrentX = (i Mod 9) * UnitSize + XAdjust + XOffset
          TgtObject.Print ii
        End If
      Next ii
    End If
  Next i
End With
End Sub
Public Function InvertSudokuBits(ByRef SudokuBoardBits() As Long) As Long()
'Possible Solutions to Impossible Solutions and visa versa
    Dim i As Long, lngOut(80) As Long
    For i = 0 To 80
      lngOut(i) = SudokuBoardBits(i) Xor BITS9
    Next i
    InvertSudokuBits = lngOut
End Function

---

BugFix: 17/7/7

Code:

---

Public Function SudokuStringToLongArray(ByRef SudokuBoard As String) As Long()
    Dim lngA As Long, lngCurrent As Long, lngOut(80) As Long
    ' validate length
    If LenB(SudokuBoard) = 162 Then
        For lngA = 0 To 80
            ' get the number
            lngCurrent = AscW(Mid$(SudokuBoard, 1 + lngA, 1)) And Not 48
            ' see which bits to set active by this number
            If lngCurrent > 0 And lngCurrent < 10 Then
                ' mark only the known bit active
                lngOut(lngA) = BITTABLE(lngCurrent)
            Else
                ' mark all bits active
                lngOut(lngA) = BITS9
            End If
        Next lngA
    End If
    ' output
    SudokuStringToLongArray = lngOut
End Function

---

The following 3 subs work together to create a valid sudoku grid.
They work basically the way a designer makes them. place a 1 randomly in one 3x3 square, put one in the next square wherever it is legal to put it, and so on until all ones are done, then move on to 2 and fill all of them in. Expects there to be a global variable SudokuGrid(8,8) as integer

Code:

---

    Private Sub SetupGrid()
Dim cl As Integer, xl As Long
Call EraseSudokuGrid()
For cl = 1 To 9
  Do

      If GenerateGrid(cl) = True Then Exit Do
      xl = xl + 1
      If xl = 10 Then 'if you get too many grid failures, start over
          Call EraseSudokuGrid()
          xl = 0
          cl = 0
          Exit Do
      End If
  Loop
Next cl
Me.Invalidate()
  End Sub
  Private Sub EraseSudokuGrid()
    Dim x As Integer, y As Integer
  For x = 0 To 8
      For y = 0 To 8
        SudokuGrid(x, y) = 0
      Next
  Next

  End Sub
  Private Function GenerateGrid(ByVal Num As Integer)
Dim ExitCounter As Long
Dim BlockedGrid(8, 8) As Boolean
Dim WorkGrid(8, 8) As Boolean
Dim Rnd_X As Long, Rnd_Y As Long
Dim x As Long, y As Long
Dim BlockedGrid_X As Long ', BlockedGrid_Y As Long
Dim Illegal As Boolean
'plan:  Fill in work grid, using blockedgrid to check with.
'then parse and make sure each entry is available in sudokugrid
'if not, start over
For y = 0 To 8 Step 3
  For x = 0 To 8 Step 3
      Do
        ExitCounter = ExitCounter + 1
        If ExitCounter = 500 Then GenerateGrid = False : Exit Function ' in case of grid lock up
        Illegal = False 'marker
        'this loop returns a base value of the upper left corner of each square
        'first, generate a x & y location
        Rnd_X = Int(Rnd() * 3) + x 'adds 0,1, or 2 to current x
        Rnd_Y = Int(Rnd() * 3) + y 'adds 0,1, or 2 to current x
        'make sure location isn't taken
        Illegal = BlockedGrid(Rnd_X, Rnd_Y)
        If Illegal = False Then If SudokuGrid(Rnd_X, Rnd_Y) <> 0 Then Illegal = True
        If Illegal = False Then Exit Do
      Loop
      'got a valid position, now mark it on the BlockedGrid so we
      'don't try to put another number in it's row or column
      For BlockedGrid_X = 0 To 8
        BlockedGrid(BlockedGrid_X, Rnd_Y) = True 'fill in row
        BlockedGrid(Rnd_X, BlockedGrid_X) = True  'fill in column
      Next BlockedGrid_X
      'now store the number on the workgrid
      WorkGrid(Rnd_X, Rnd_Y) = Num
  Next x
Next y

'finally, parse workgrid onto sudokugrid
For x = 0 To 8
  For y = 0 To 8
      'final error check
      If WorkGrid(x, y) = True Then
        If SudokuGrid(x, y) > 0 Then GenerateGrid = False : Exit Function 'final error check
        SudokuGrid(x, y) = Num
      End If
  Next
Next
GenerateGrid = True
  End Function

---