PureBasic Forums - English

Posted: **Mon Jun 05, 2006 3:15 am**

Hi all,
Just messing around with the new version and indulging a (hopefully short-lived) fascination with Sudoku.

Anyway, I was trying to come up with an elegant way of generating valid Sudoku grids with little success because I didn't think of recursion. So here is a completely inelegant generator that's fast nonetheless - based on some brute force pseudocode posted in a Sudoku programming forum.

Now that I've got this working I'm going to try to add recursion to my 'more refined' original attempt. Not that it matters that much - the ogre method presented here usually busts through it in couple tenths of a second. Ah, CPU power, the downfall of thoughtful code.

So, thought this might be helpful to someone.

Code: Select all

; sudoku.pb
; Main program file

; Include files
XIncludeFile"grid.pb" ; Board functions

; Main Loop
If OpenConsole()
  EnableGraphicalConsole(1)
  ClearConsole()

  ; Print title
  ConsoleLocate(2, 1)
  Print("Sudoku Test")
  
  ; Make grid
  StartTime = ElapsedMilliseconds()
    MakeGrid()
  ElapsedTime = ElapsedMilliseconds()-StartTime 

  ; Print grid
  ConsoleLocate(1, 2)
  Print("Finished Grid")
  For i = 0 To 80
    ConsoleLocate(3+i%9, 4+Round(i/9,0))
    Print(Str(bGrid(i)))
  Next i

  ; Print time
  ConsoleLocate(1, 16)
  Print("Time: " + Str(ElapsedTime) + "ms")

  ; Exit when ready
  ConsoleLocate(1, 18)
  Print("<<Hit a Key>>")
  Input()
  CloseConsole()
EndIf

End
; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 45
; FirstLine = 6
; Folding = -

Code: Select all

; grid.pb
; Sudoku grid functions


; Declare global variables
Global Dim bGrid.b(81)

; Declare functions
Declare MakeGrid()                  ; Main grid constructor
Declare.b MakeCell(index.b)         ; Recursive cell filler
Declare.b CheckGrid()               ; Validates grid (ignores zeros)


; Procedure MakeGrid()
; Fill in the board array with a valid Sodoku grid. 
; Recursively call MakeCell() and wait for success.
Procedure MakeGrid()
  ; Kick off recursive generation
  MakeCell(0)  
EndProcedure


; Procedure.b MakeCell(index.b)
; Try numbers in a particular cell. When a possible match
; is found move on to next cell. If no solution works
; fail back to previous level.
Procedure.b MakeCell(index.b)
  ; Procedure variables
  Static Dim CellOrder.b(9)

  ; Check for completion
  If index = 81
    ; The board is full, we're done!
    ProcedureReturn 1
  EndIf

  ; Set random order to try numbers
  For i = 1 To 9
    CellOrder(i) = i
  Next i
  For i = 1 To 25
    Swap CellOrder(Int(Random(8)+1)), CellOrder(Int(Random(8)+1))
  Next i  
  
  For i = 1 To 9
    bGrid(index) = CellOrder(i)
    If CheckGrid() = 1
      If MakeCell(index+1) = 1
        ProcedureReturn 1
      EndIf
    EndIf
  Next i
  
  bGrid(index) = 0
  ProcedureReturn -1  
  
EndProcedure


; Procedure.b CheckGrid()
; Validate grid by ensuring that the numbers one through
; nine only appear once in each row, column, and quadrant.
Procedure.b CheckGrid()
  ; Procedure variables
  Protected Dim Counts(9)

  ; Check columns
  For row = 0 To 8
    For col = 0 To 8
      If bGrid(row*9+col) > 0
        ; Add number here to count
        Counts(bGrid(row*9+col)) = Counts(bGrid(row*9+col)) + 1
        ; If there's more than one then fail
        If Counts(bGrid(row*9+col)) > 1
          ProcedureReturn -1
        EndIf
      EndIf    
    Next col
    ; Clear counts  
    For i = 0 To 9
      Counts(i) = 0
    Next i
  Next row

  ; Check rows
  For col = 0 To 8
    For row = 0 To 8
      If bGrid(row*9+col) > 0
        ; Add number here to count
        Counts(bGrid(row*9+col)) = Counts(bGrid(row*9+col)) + 1
        ; If there's more than one then fail
        If Counts(bGrid(row*9+col)) > 1
          ProcedureReturn -1
        EndIf
      EndIf    
    Next row
    ; Clear counts  
    For i = 0 To 9
      Counts(i) = 0
    Next i
  Next col

  ; Check quadrants
  For quad = 0 To 8
    Select quad
      Case 0, 3, 6
        bx = 0
      Case 1, 4, 7
        bx = 3
      Default
        bx = 6
    EndSelect
    Select quad
      Case 0, 1, 2
        by = 0
      Case 3, 4, 5
        by = 3
      Default
        by = 6
    EndSelect 
    For row = 0 To 2
      For col = 0 To 2
        If bGrid((by+row)*9+bx+col) > 0
          ; Add number here to count
          Counts(bGrid((by+row)*9+bx+col)) = Counts(bGrid((by+row)*9+bx+col)) + 1
          ; If there's more than one then fail
          If Counts(bGrid((by+row)*9+bx+col)) > 1
            ProcedureReturn -1
          EndIf
        EndIf    
      Next col
    Next row
    ; Clear counts  
    For i = 0 To 9
      Counts(i) = 0
    Next i
  Next quad

  ; We passed all of the tests
  ProcedureReturn 1
  
EndProcedure

; IDE Options = PureBasic v4.00 (Windows - x86)
; CursorPosition = 16
; Folding = 5

Posted: **Tue Jun 06, 2006 7:22 am**

mearrin69 wrote:Anyway, I was trying to come up with an elegant way of generating valid Sudoku grids with little success because I didn't think of recursion.

Hi mearrin69 - you're generating engine is quite fast (so it is elegant for me

).

But the most difficult thing is not to fill a grid but to remove items that the puzzle is still solvable and if possible, the left numbers are also symmetrical. Especially for the last point I couldn't find a perfect solution (maybe someone can give me a hint how to do it)

Anyway you can have a look at my Sudoku Puzzle at http://sudokuprogram.googlepages.com

Posted: **Tue Jun 06, 2006 8:10 am**

Yeah, I've been looking at that. I think I have to complete my solver before I can do that properly. My best guess is to establish a number of 'givens' that put you in the ball park for the desired difficulty level then run the solver to see how difficult the puzzle actually is - then adjust the number of givens up or down until you get to where you need to be.

I think the solver will be quite fast so it shouldn't be a problem even if it had to run several times to establish a proper set of givens. More difficult, for me at least, is figuring out how to convert the output of the solver (time, iterations, whatever) into 'human' difficulty levels. That'll be the real trick I think.

Will take a look at your stuff shortly - thanks for the link.
Michael

PureBasic Forums - English

Fun with Sudoku

Fun with Sudoku

Re: Fun with Sudoku