sudoku.rkt

(define (solve grid)
  (let ([result (fill-allowed grid)])
    (if (equal? grid result)
        result
        (solve result))))

; Finds the allowed digits for each cell in the grid,
; and if there's only one choice, fills it in.
(define (fill-allowed grid)
  (for/list ([r (in-range 1 10)])
    (flatten-singletons
      (for/list ([c (in-range 1 10)])
        (allowed-digits grid r c)))))

; If there are any lists with a single member, extract that member.
(define (flatten-singletons xs)
  (cond
    [(empty? xs) '()]
    [(and (list? (car xs)) (= 1 (length (car xs))))
          (cons (caar xs) (flatten-singletons (cdr xs)))]
    [else (cons (car xs) (flatten-singletons (cdr xs)))]))

; Returns a list of digits that are allowed to appear
; in a cell, given the existing digits in the same row,
; column, and square.
(define (allowed-digits grid r c)
  (let ([v (get-value grid r c)])
    (if (and (number? v) (positive? v)) v
    (let ([row (get-row grid r)]
          [col (get-column grid c)]
          [sq  (get-square grid r c)]
          [digits '(1 2 3 4 5 6 7 8 9)])
        (set-subtract digits
           (flatten (map (curry filter positive?)
                      (map (curry filter number?)
                        (list row col sq)))))))))

(define (get-row grid r)
  (element-at r grid))

(define (get-column grid c)
  (for/list ([i (in-range 1 10)])
            (get-value grid i c)))

; Returns a 3x3 square as a flattened list.
(define (get-square grid r c)
  (define (positions sq-n)
    (map (curry + (* 3 (sub1 sq-n))) '(1 2 3)))
  (define (flat-square sq)
    (append (first sq) (second sq) (third sq)))
  (let ([sq-x (ceiling (/ r 3))]
        [sq-y (ceiling (/ c 3))])
    (flat-square (for/list ([i (positions sq-x)])
                   (for/list ([j (positions sq-y)])
                     (get-value grid i j))))))

; Get the value of a cell given the coordinates.
(define (get-value grid r c)
  (element-at c (element-at r grid)))

; I start indexing at 1 here,
; this helps with get-square.
(define (element-at pos xs)
  (cond
    [(empty? xs) '()]
    [(= 1 pos) (car xs)]
    [else (element-at (sub1 pos) (cdr xs))]))