Solving Sudoku with Amb Operator

Sudoku is an interesting puzzle game. The goal of Sudoku is to fill a 9x9 grid with numbers from 1 to 9, which makes the sum of each row, each column, and each 3x3 block is the same. In other words, each row, column and block must contains all of numbers from 1 to 9.

Writing a program to solve a Sudoku is not hard, but this article shows how to solve Sudoku with non-deterministic operator amb. The word Amb stands for ambiguity. The amb operator takes a set of one or more values, tries to find a value that satisfies some constraints. The constraints can be specified in the future computation. The amb operator may choose a value from the set randomly, or may sequentially. If the current chosen value not satisfies the constraints, amb operator will atomatically try next one until some value satisfies the constraints. In the following code, we use assert to specify constraints.

The Chapter 4 of book Structure and Interpretation of Computer Programs is also a good material of non-deterministic computation.

The code can be also found in my Github repo.

#lang racket

(require math/base)

;; Amb operator
;; The amb operator implementation is from Matt Might's blog:

(define current-continuation
  (λ () (call/cc (lambda (cc) (cc cc)))))

(define fail-stack '())

(define (fail)
  (if (not (pair? fail-stack))
      (error "back-tracking stack exhausted!")
      (let ([back-track-point (car fail-stack)])
        (set! fail-stack (cdr fail-stack))
        (back-track-point back-track-point))))

(define (amb choices)
  (let ([cc (current-continuation)])
    (cond [(null? choices) (fail)]
          [(pair? choices)
           (let ([choice (car choices)])
             (set! choices (cdr choices))
             (set! fail-stack (cons cc fail-stack))

(define (assert pred) (if (not pred) (fail) #t))

We can try an example. Declared that x and y both could be 1, 2 or 3, and x-plus-y is the sum of x and y. Then we assert that x-plus-y should be 6. If we change the assertion line to be equal 7, then there is no combination of x and y‘s possible value can be sumed to 7, so the search will be exhausted (failed).

(let* ([x (amb '(1 2 3))]
       [y (amb '(1 2 3))]
       [x-plus-y (+ x y)])
  (assert (eq? x-plus-y 6))
  (displayln x-plus-y))')]')]))

The Solver

;; Sudoku Solver

(define (transpose grid)
    (if (null? grid) '()
        (map (λ (i) (map (λ (line) (list-ref line i)) grid))
             (range (length (car grid))))))

(define get-col (λ (g i) (map (λ (line) (list-ref line i)) g)))

(define (get-block grid M N row col)
  (let ([row (add1 (floor (/ row N)))]
        [col (floor (/ col M))])
    (flatten (for/list ([i (range (* (sub1 row) N) (* row N))])
      (take (drop (list-ref grid i) (* col M)) M)))))

(define (each-block grid M N)
  (foldl append '()
         (for/list ([row (range 0 (* M N) N)])
           (for/list ([col (range 0 (* M N) M)])
             (get-block grid M N row col)))))

(define get-used-num (curry filter (λ (x) (not (zero? x)))))

(define (grid-get grid row col) (list-ref (list-ref grid row) col))

(define (grid-set grid row col ele)
  (list-set grid row (list-set (list-ref grid row) col ele)))

(define (solve grid M N)
  (define side-length (* M N))
  (define total (sum (range 1 (add1 side-length))))
  (define (end? row col) (and (= side-length row) (= 0 col)))
  (define (next-row row col)
    (if (zero? (modulo (add1 col) side-length)) (add1 row) row))
  (define (next-col row col)
    (if (zero? (modulo (add1 col) side-length)) 0 (add1 col)))
  (define (get-possible-choices grid row col)
    (if (not (= 0 (grid-get grid row col))) '()
        (let ([row-cns (get-used-num (list-ref grid row))]
              [col-cns (get-used-num (get-col grid col))]
              [blk-cns (get-used-num (get-block grid M N row col))])
          (remv* (remove-duplicates (flatten `(,row-cns ,col-cns ,blk-cns)))
                 (range 1 (add1 side-length))))))
  (define (gen-constraints grid row col)
    (cond [(end? row col) grid]
          [(not (= 0 (grid-get grid row col)))
           (gen-constraints grid (next-row row col) (next-col row col))]
          [else (gen-constraints 
                  (grid-set grid row col (amb (get-possible-choices grid row col)))
                  (next-row row col) (next-col row col))]))

  ;; Setup the constraints
  (let ([g (gen-constraints grid 0 0)])
    (for/list ([line g]) (assert (= total (sum line))))
    (for/list ([line (transpose g)]) (assert (= total (sum line))))
    (for/list ([block (each-block g M N)]) (assert (= total (sum block))))

Finally, let’s try our Sudoku solver!

;; Test

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

    (0 0 3  0 1 0  0 8 0)
    (9 0 0  8 6 3  0 0 5)
    (0 5 0  0 9 0  6 0 0)

    (1 3 0  0 0 0  2 5 0)
    (0 0 0  0 0 0  0 7 4)
    (0 0 5  2 0 6  3 0 0)))

(solve grid 3 3)