`(amb ...)`.

A primary goal here for reasonable performance was to minimize (within reasonable coding effort) the number of continuations which have to be captured by the `amb` operator---hence the repeated narrowing of possibilities before calls to `amb`. Here's the code (including a nifty macro which allows specifying a puzzle easily):

(module sudoku mzscheme (require (all-except (lib "43.ss" "srfi") vector-fill! vector->list) (only (lib "1.ss" "srfi") filter take drop) (lib "extra.ss" "swindle")) (provide sudoku-board solve write-sudoku-board) ;; Sudoku board is eventually represented as a vector of rows ;; which are themselves vectors of length nine. The syntax ;; sudoku-board produces such a board from a list of numbers or ;; '?, which represents an unknown square. (define (any) (list 1 2 3 4 5 6 7 8 9)) (define (list->board lst) (apply vector (let loop ((lst lst) (list-of-nines '())) (if (null? lst) (reverse list-of-nines) (loop (drop lst 9) (cons (apply vector (take lst 9)) list-of-nines)))))) (define-syntax sudoku-board (syntax-rules () ((sudoku-board elt ...) (list->board (process-elts (processed ) elt ...))))) (define-syntax process-elts (syntax-rules (processed ?) ((process-elts (processed pelt ...) ?) (reverse (list (any) pelt ...))) ((process-elts (processed pelt ...) elt) (reverse (list elt pelt ...))) ((process-elts (processed pelt ...) ? elt ...) (process-elts (processed (any) pelt ...) elt ...)) ((process-elts (processed pelt ...) elt elt2 ...) (process-elts (processed elt pelt ...) elt2 ...)))) (define (cubant i) (floor (/ i 3))) (define (same-cubant? ii jj i j) (and (= (cubant i) (cubant ii)) (= (cubant j) (cubant jj)))) (define (known? elt) (number? elt)) (define (unknown? elt) (list? elt)) (define (board-map fn board) (vector-map (lambda (i row) (vector-map (lambda (j elt) (fn i j elt)) row)) board)) (define (board-fold fn start board) (vector-fold (lambda (i start row) (vector-fold (lambda (j start elt) (fn i j start elt)) start row)) start board)) (define (board-ref b i j) (vector-ref (vector-ref b i) j)) (define (prune ii jj number board) (board-map (lambda (i j elt) (if (known? elt) elt (cond ((= i ii) (filter (lambda (elt) (not (= elt number))) elt)) ((= j jj) (filter (lambda (elt) (not (= elt number))) elt)) ((same-cubant? ii jj i j) (filter (lambda (elt) (not (= elt number))) elt)) (else elt)))) board)) (define (singleton? elt) (and (pair? elt) (null? (cdr elt)))) (define (expand-singletons board) (board-map (lambda (i j elt) (if (singleton? elt) (car elt) elt)) board)) (define (prune-all board) (let ((new-board (expand-singletons (board-fold (lambda (i j nb elt) (if (known? elt) (prune i j elt nb) nb)) board board)))) (if (equal? new-board board) new-board (prune-all new-board)))) (define (amb-list list) (if (null? list) (amb) (amb (car list) (amb-list (cdr list))))) (define (amb-board board) (board-fold (lambda (i j nb elt) (let ((elt (board-ref nb i j))) (if (known? elt) nb (let ((choice (amb-list elt))) (prune-all (board-map (lambda (ii jj elt) (if (and (= i ii) (= j jj)) choice elt)) nb)))))) board board)) (define (board-assertions board) (board-fold (lambda (i j dummy elt1) (board-fold (lambda (ii jj dummy elt2) (cond ((and (= ii i) (= jj j))) ((= ii i) (amb-assert (not (= elt1 elt2)))) ((= jj j) (amb-assert (not (= elt1 elt2)))) ((same-cubant? ii jj i j) (amb-assert (not (= elt1 elt2)))))) '() board)) '() board)) (define (solve board) (let ((new-board (prune-all board))) (let ((final-board (amb-board new-board))) (board-assertions final-board) final-board))) (define (write-sudoku-board board) (printf "(sudoku-board") (board-fold (lambda (i j dummy elt) (if (= j 0) (newline)) (if (pair? elt) (printf " ?") (printf " ~a" elt)) (if (and (= i 8) (= j 8)) (printf ")~%"))) '() board)))

Example of use:

(write-sudoku-board (solve (sudoku-board ? ? 8 ? ? ? 1 5 ? ? ? ? ? ? 1 8 ? ? 3 ? 5 4 ? ? ? ? 9 5 ? ? ? ? 9 ? ? ? ? 9 ? 2 3 4 ? 7 ? ? ? ? 1 ? ? ? ? 8 4 ? ? ? ? 5 9 ? 1 ? ? 6 7 ? ? ? ? ? ? 5 3 ? ? ? 2 ? ?)))which evaluates to

(sudoku-board 7 4 8 3 9 2 1 5 6 2 6 9 5 7 1 8 4 3 3 1 5 4 8 6 7 2 9 5 7 4 8 6 9 3 1 2 8 9 1 2 3 4 6 7 5 6 3 2 1 5 7 4 9 8 4 8 7 6 2 5 9 3 1 9 2 6 7 1 3 5 8 4 1 5 3 9 4 8 2 6 7)