Sudoku solver in Racket

Question

I have written following code to solve Sudoku puzzles in Racket (a Scheme/Lisp derivative programming language). Following relatively simple code appears to work but are there any bugs in it or can it be further optimized? (semi-colon indicates start of comment on that line).

(define (SolveSudoku sentboard)
  (define (subgrid brd r c)
    (define ll '((0 1 2)(3 4 5)(6 7 8)))
    (define-values (rr cc)
      (values (flatten (filter (λ (x) (member r x)) ll))
              (flatten (filter (λ (x) (member c x)) ll))))
    (for*/list ((i rr)(j cc))
      (list-ref (list-ref brd i) j)))
  (let loop ((bd sentboard) (r 0) (c 0))
    (cond [(= 0 (list-ref (list-ref bd r) c) )
           (for ((i (range 1 10)))
             (when (and (not(member i (list-ref bd r)))                 
                        (not(member i (map (λ (x) (list-ref x c)) bd))) 
                        (not(member i (subgrid bd r c))))                
               (define newbd (list-set bd r
                                       (list-set (list-ref bd r) c i)))
               (cond [(< (add1 c) 9)
                      (loop newbd r (add1 c) )]
                     [(< (add1 r) 9)
                      (loop newbd (add1 r) 0 )]
                     [else (displayln "SOLUTION:")
                           (for ((rowline newbd)) (println rowline))])))]
          [(< (add1 c) 9)
           (loop bd r (add1 c))]
          [(< (add1 r) 9)
           (loop bd (add1 r) 0)]
          [else (displayln "Solution:")  
                (for ((rowline bd)) (println rowline))])))

Following is code with comments added:

(define (SolveSudoku sentboard)
  ; subfn to get list of numbers in 3x3 subgrid for a given row and column position: 
  (define (subgrid brd r c)
    (define ll '((0 1 2)(3 4 5)(6 7 8)))
    ; get row/column set to which r and c belong:
    (define-values (rr cc)
      (values (flatten (filter (λ (x) (member r x)) ll))
              (flatten (filter (λ (x) (member c x)) ll))))
    ; get all numbers from this set:
    (for*/list ((i rr)(j cc))
      (list-ref (list-ref brd i) j)))

  ; start with sent board and first row and column: 
  (let loop ((bd sentboard) (r 0) (c 0))
    (cond
      ; if entry at (r,c) is 0, try to put numbers from 1 to 9:
      [(= 0 (list-ref (list-ref bd r) c) )
       (for ((i (range 1 10)))
         ; if i is not present in that row, column & subgrid:
         (when
             (and (not(member i (list-ref bd r)))                 ; number not in row
                  (not(member i (map (λ (x) (list-ref x c)) bd))) ; number not in column
                  (not(member i (subgrid bd r c))))               ; number not in subgrid
           ; create a new board with i added:
           (define newbd
             (list-set bd r
                       (list-set (list-ref bd r) c i)))
           (cond
             ; go to next column and loop:
             [(< (add1 c) 9)
              (loop newbd r (add1 c) )]
             ; if columns over, go to next row and loop:
             [(< (add1 r) 9)
              (loop newbd (add1 r) 0 )]
             ; if rows also over, solution found:
             [else (displayln "SOLUTION:")
                   (for ((rowline newbd)) (println rowline))])))]

      ; if entry is not 0 go to next column or row (as above): 
      [(< (add1 c) 9)
       (loop bd r (add1 c))]
      [(< (add1 r) 9)
       (loop bd (add1 r) 0)]
      [else (displayln "Solution:")  
            (for ((rowline bd)) (println rowline))])))

Testing:

(define board                   
  '((0 0 3 0 2 0 6 0 0)
    (9 0 0 3 0 5 0 0 1)
    (0 0 1 8 0 6 4 0 0)
    (0 0 8 1 0 2 9 0 0)
    (7 0 0 0 0 0 0 0 8)
    (0 0 6 7 0 8 2 0 0)
    (0 0 2 6 0 9 5 0 0)
    (8 0 0 2 0 3 0 0 9)
    (0 0 5 0 1 0 3 0 0)))

(define b2
  '((3 9 4 0 0 2 6 7 0)
    (0 0 0 3 0 0 4 0 0)
    (5 0 0 6 9 0 0 2 0)
    (0 4 5 0 0 0 9 0 0)
    (6 0 0 0 0 0 0 0 7)
    (0 0 7 0 0 0 5 8 0)
    (0 1 0 0 6 7 0 0 8)
    (0 0 9 0 0 8 0 0 0)
    (0 2 6 4 0 0 7 3 5)))

(SolveSudoku board)
(SolveSudoku b2)

Output:

SOLUTION:
'(4 8 3 9 2 1 6 5 7)
'(9 6 7 3 4 5 8 2 1)
'(2 5 1 8 7 6 4 9 3)
'(5 4 8 1 3 2 9 7 6)
'(7 2 9 5 6 4 1 3 8)
'(1 3 6 7 9 8 2 4 5)
'(3 7 2 6 8 9 5 1 4)
'(8 1 4 2 5 3 7 6 9)
'(6 9 5 4 1 7 3 8 2)
Solution:
'(3 9 4 8 5 2 6 7 1)
'(2 6 8 3 7 1 4 5 9)
'(5 7 1 6 9 4 8 2 3)
'(1 4 5 7 8 3 9 6 2)
'(6 8 2 9 4 5 3 1 7)
'(9 3 7 1 2 6 5 8 4)
'(4 1 3 5 6 7 2 9 8)
'(7 5 9 2 3 8 1 4 6)
'(8 2 6 4 1 9 7 3 5)

Answer 1

This looks like a fairly reasonable brute force method. From what I've gathered though, the for loop will try for all combination rather than just the first valid one. However the for will sequence the operation to avoid a huge memory overhead.

However if the puzzle is not well constructed it may have more than one valid solution, and I suspect this code will print them both. https://sandwalk.blogspot.com/2007/06/i-knew-it-there-can-be-more-than-one.html

A custom loop that breaks when a solution is found would on average run in half the time, and never give you more than one solution. But I'm not going to show you how to do it, since there are several solutions, and it's not a huge improvement.

A few minor things.

  [(< (add1 c) 9)
   (loop bd r (add1 c))]

And similar lines could easily be rewritten like

  [(< c 8)       (loop bd r (add1 c))]

(and (not A) (not B) ...) is more simply written as '(not (or A B ...))

And a little more DSL would make the code more self-documenting.

And notice how you have almost exactly the same (cond ...)in two different locations, and the only difference is the next board you pass along. A good candidate for a little more abstraction.

(define (SolveSudoku sentboard)
  ;Seting up the DSL
  (define (row brd r) (list-ref brd r))
  (define (column brd c) (map (λ (r) (list-ref r c)) brd))
  (define (subgrid brd r c)
    (define ll '((0 1 2)(3 4 5)(6 7 8))) ;')
    (define-values (rr cc)
      (values (flatten (filter (λ (x) (member r x)) ll))
              (flatten (filter (λ (x) (member c x)) ll))))
    (for*/list ((i rr)(j cc))
      (list-ref (list-ref brd i) j)))
  (define (cell brd r c)  (list-ref (list-ref brd r) c))
  (define (new-board-with-updated-value bd r c val)
     (list-set bd r (list-set (list-ref bd r) c val)))
  (let loop ((bd sentboard) (r 0) (c 0)) ;initialize counters
       (let ((next (lambda (nextbd) ;the next step through the board
                     (cond [(< c 8)  (loop nextbd r (add1 c) )]
                           [(< r 8)  (loop nextbd (add1 r) 0 )]
                           [else (displayln "SOLUTION:")
                                 (for ((rowline nextbd)) 
                                       (println rowline))]))))
         (if (= 0 (cell bd r c))
             (for ((i (range 1 10)))
;brute force the solution, with a simple collision check first
                   (when (not (or (member i (row     bd r))                 
                                  (member i (column  bd c)) 
                                  (member i (subgrid bd r c))))              
                      (next (new-board-with-updated-value bd r c i))))
                 (next bd))))) 

Now I know I've messed up brackets or parenthesis somewhere, but I hope I've given you and idea on how much cleaner the code can be. And now as a bonus, because I've abstracted how the loop interacts with the data, you are now able to replace the list of lists data structure with a better data structure. Not that it would make a huge difference for a data set this small, but could give you order of magnitude savings on different sorts of problems.

Answer 2

Following is shortened working code.

It is based on simple systematic search & recursion algorithm: read the rows one by one from left to right and top to bottom, starting with first row and first column. If the cell is blank (0 here), try to put numbers 1-9. Each number is checked that it should not be present in that row, column or subgrid. If no such number is found, the loop will return to previous level (previous empty cell) and try next number there. Once a suitable number is found, it is placed at the site and the loop is started again with next column (if columns are over, it moves over to first column of next row). If all rows and columns are done, it means a solution has been reached and the same is printed. One can exit at this time to stop immediately on finding a solution.

A separate subfunction is made to return numbers in the corresponding subgrid as a list. A common subfunction to step forward to next site/cell is provided to replace 2 very similar code segments in original program. There is no need for separate subfunctions to get cell value, row or column values since these are short code snippets are are needed only once in the program.

(define (SolveSudoku sentboard)

  (define (subgrid brd r c)                     ; subfn to get subgrid:
    (define L '((0 1 2)(3 4 5)(6 7 8)))
    (define-values (rr cc)
      (values (flatten(filter (λ(x)(member r x)) L))   ; get the row set
              (flatten(filter (λ(x)(member c x)) L)))) ; get the column set
    (for*/list ((i rr)(j cc))          ; get list of numbers in these rows & columns
      (list-ref (list-ref brd i) j)))

  ; start with sentboard and first row and column: 
  (let loop ((bd sentboard) (r 0) (c 0))
    (let ((next (λ (nextbd)                     ; subfn to go to next column/row:
                  (cond [(< c 8)  (loop nextbd r (add1 c) )]
                        [(< r 8)  (loop nextbd (add1 r) 0 )]
                        [else (displayln "SOLUTION:")
                              (for ((rowline nextbd)) 
                                (println rowline))
                              ;(exit) can be added here to stop at first solution.
                              ]))))
      (if (= 0 
             (list-ref (list-ref bd r) c))     ; cell value: if 0, try numbers 1-9:  
          (begin (for ((i (range 1 10)))
                   (when(not(or    ; number should not be in row/column/subgrid:
                             (member i (list-ref bd r))               ; row
                             (member i (map (λ(x)(list-ref x c)) bd)) ; column
                             (member i (subgrid bd r c))))            ; subgrid
                     (define newbd              ; put number i at this site:
                       (list-set bd r
                                 (list-set (list-ref bd r) c i)))
                     (next newbd)))) 
          (next bd)))))

Test example:

(define board                   
  '((0 0 3 0 2 0 6 0 0)
    (9 0 0 3 0 5 0 0 1)
    (0 0 1 8 0 6 4 0 0)
    (0 0 8 1 0 2 9 0 0)
    (7 0 0 0 0 0 0 0 8)
    (0 0 6 7 0 8 2 0 0)
    (0 0 2 6 0 9 5 0 0)
    (8 0 0 2 0 3 0 0 9)
    (0 0 5 0 1 0 3 0 0)))

(SolveSudoku board)

Output:

SOLUTION:
'(4 8 3 9 2 1 6 5 7)
'(9 6 7 3 4 5 8 2 1)
'(2 5 1 8 7 6 4 9 3)
'(5 4 8 1 3 2 9 7 6)
'(7 2 9 5 6 4 1 3 8)
'(1 3 6 7 9 8 2 4 5)
'(3 7 2 6 8 9 5 1 4)
'(8 1 4 2 5 3 7 6 9)
'(6 9 5 4 1 7 3 8 2)