sudoku-solver/solver.scm

(define-module (sudoku solver))

(use-modules (srfi srfi-1)
             (ice-9 receive)
             (ice-9 control)
             (sudoku utils)
             (sudoku square)
             (sudoku board))

(define-public (solver board)
  (call/ec
    (lambda (return)
      (solver-loop board return))))

;; TODO; break up
(define (solver-loop board return)
  (receive (min-square i j)
           (find-min-square board)
    (define (find-solution-from-candidates candidates)
      (if (null? candidates)
        #f
        (begin
          (solver-loop
           (let ((n-board (make-9x9-board)))
             (set-board-array! n-board (board-array board))
             (set-square! n-board
                          (set-square-value min-square
                                           (car candidates))
                         i j)
             (update-board-candidates n-board))
           return)
          (find-solution-from-candidates (cdr candidates)))))
    (cond
      ((null? min-square) (return board))
      ((zero? (length (square-candidates min-square))) board)
      (else (find-solution-from-candidates (square-candidates min-square))))))

(define (find-min-square board)
  (let ((min-square-l
          (array-fold
            (lambda (item acc)
              (if (and (= 0 (square-value (car item)))
                       (< (length (square-candidates (car item)))
                          (length (square-candidates (car acc)))))
                item
                acc))
            (list (make-square 9) -1 -1)
            (board-array board))))
    (if (array-in-bounds? (board-array board)
                          (cadr min-square-l) (last min-square-l))
      (values (car min-square-l) (cadr min-square-l) (last min-square-l))
      (values '() -1 -1))))

(define (update-board-candidates board)
  (for-each (lambda (i)
              (update-row (update-col (update-box board i) i) i))
            (iota 9))
  board)

(define-public (update-row board i)
  (update-group set-row! get-row board i)
  board)

(define-public (update-col board j)
  (update-group set-col! get-col board j)
  board)

(define-public (update-box board k)
  (update-group set-box! get-box board k)
  board)

(define (update-group set-proc get-proc board i)
  (set-proc board
           (update-list
             (get-proc board i))
           i))

(define (update-list l)
  (let ((vals (get-vals l)))
    (map (lambda (square)
           (update-candidates square vals))
         l)))

(define (get-vals squares)
  (fold (lambda (square vals)
          (if (> (square-value square) 0)
              (cons (square-value square) vals)
              vals))
        '()
        squares))

(define (update-candidates square vals)
  (set-square-candidates square
                  (lset-difference eq?
                                   (square-candidates square)
                                   vals)))