Simple Sudoku solver
Unknown
It solves the easy puzzles below in the blink of an eye,
but the hard one takes about 37 seconds on my desktop computer.
The program reads a puzzle from stdin, so just copy and paste.
If you have a puzzle that uses something besides "_" to represent an
empty cell, give the string on the command-line.
#|
Easy:
_ 6 _ 1 _ 4 _ 5 _
_ _ 8 3 _ 5 6 _ _
2 _ _ _ _ _ _ _ 1
8 _ _ 4 _ 7 _ _ 6
_ _ 6 _ _ _ 3 _ _
7 _ _ 9 _ 1 _ _ 4
5 _ _ _ _ _ _ _ 2
_ _ 7 2 _ 6 9 _ _
_ 4 _ 5 _ 8 _ 7 _
+-------+-------+-------+
| _ _ 2 | _ _ 5 | _ 7 9 |
| 1 _ 5 | _ _ 3 | _ _ _ |
| _ _ _ | _ _ _ | 6 _ _ |
+-------+-------+-------+
| _ 1 _ | 4 _ _ | 9 _ _ |
| _ 9 _ | _ _ _ | _ 8 _ |
| _ _ 4 | _ _ 9 | _ 1 _ |
+-------+-------+-------+
| _ _ 9 | _ _ _ | _ _ _ |
| _ _ _ | 1 _ _ | 3 _ 6 |
| 6 8 _ | 3 _ _ | 4 _ _ |
+-------+-------+-------+
| _ _ _ | _ 7 _ | 9 4 _ |
| _ 7 _ | _ 9 _ | _ _ 5 |
| 3 _ _ | _ _ 5 | _ 7 _ |
+-------+-------+-------+
| _ 8 7 | 4 _ _ | 1 _ _ |
| 4 6 3 | _ 8 _ | _ _ _ |
| _ _ _ | _ _ 7 | _ 8 _ |
+-------+-------+-------+
| 8 _ _ | 7 _ _ | _ _ _ |
| 7 _ _ | _ _ _ | _ 2 8 |
| _ 5 _ | 2 6 8 | _ _ _ |
Not solvable:
| _ _ _ | _ _ _ | _ _ _ |
| 7 _ _ | _ 8 _ | 3 _ _ |
| _ _ _ | 7 _ _ | _ _ _ |
+-------+-------+-------+
| _ _ _ | _ _ _ | _ _ _ |
| _ _ 9 | _ 1 _ | _ _ _ |
| _ _ _ | _ _ 7 | _ _ _ |
+-------+-------+-------+
| _ _ 1 | _ _ 8 | _ 2 _ |
| _ _ _ | _ 2 6 | _ _ 1 |
| _ _ _ | 3 _ 5 | _ _ _ |
__1_2_8__
_7_31__9_
3___45__7
_9_7__5__
_42_5_13_
__3__9_4_
2__57___4
_3__91_6_
__4___3__
Hard:
+-------+-------+-------+
| _ _ 6 | 9 _ _ | _ 7 _ |
| _ _ _ | _ 1 _ | _ _ 2 |
| 8 _ _ | _ _ _ | _ _ _ |
+-------+-------+-------+
| _ 2 _ | _ _ _ | _ _ 4 |
| _ _ _ | _ _ _ | _ _ 1 |
| _ _ 5 | _ _ 6 | _ _ _ |
+-------+-------+-------+
| _ _ _ | _ _ _ | _ 6 _ |
| _ _ _ | _ _ 2 | _ 5 _ |
| _ 1 _ | _ 4 3 | _ _ _ |
+-------+-------+-------+
|#
(module sudoku
;; For lset-difference.
(library srfi1))
(define (parse-line line empty-cell)
(let [(line (pregexp-replace* "\\D"
(pregexp-replace* empty-cell line "0") ""))]
(map string->number (pregexp-split "" line))))
(define (read-board empty-cell)
(let loop [(board '())]
(let [(line (read-line))]
(if (eq? #eof-object line)
(reverse board)
(let [(row (parse-line line empty-cell))]
(loop (if (= 9 (length row)) (cons row board) board)))))))
(define (full? board)
(every? (lambda(row)(equal? row (delete 0 row))) board))
(define (get-cell board y x)
(list-ref (list-ref board y) x))
(define (set-cell! board y x val)
(list-set! (list-ref board y) x val))
(define (slice lst start len)
(take (drop lst start) len))
(define (square-contents board y x)
(let [(yy (* 3 (quotient y 3)))
(xx (* 3 (quotient x 3)))]
(apply append
(map (lambda(row) (slice row xx 3)) (slice board yy 3)))))
(define (find-avail board y x)
(let [(ver (map (lambda(row)(list-ref row x)) board))
(hor (list-ref board y))
(square (square-contents board y x))]
(lset-difference = (iota 9 1) ver hor square)))
(define (find-most-constrained board)
(let [(least 99) (yy 0) (xx 0)]
(do [(y 0 (+ y 1))]
[(or (< least 2)(= y 9))]
(do [(x 0 (+ x 1))]
[(or (< least 2) (= x 9))]
(if (= 0 (get-cell board y x))
(let [(n (length (find-avail board y x)))]
(when (< n least)
(set! least n)
(set! xx x)
(set! yy y))))))
(values yy xx)))
(define (solve board)
(if (full? board)
#t
(multiple-value-bind (y x) (find-most-constrained board)
(if (any? (lambda(n)
(set-cell! board y x n)
(solve board))
(find-avail board y x))
#t
(begin (set-cell! board y x 0)
#f)))))
(let*
[(empty-cell
(if (> (length (command-line)) 1) (cadr (command-line)) "_"))
(board (read-board empty-cell))]
(display "Empty cell is represented by ")
(pp empty-cell)
(pp board)
(if (= 9 (length board))
(begin
(pp (solve board))
(pp board))
(display "Not 9 rows in board.")))
--
tivrfoa
I'm doing a poker game, but in Java xD
Phil Bewig
My solution is at http://programmingpraxis.com/2009/02/19/sudoku/.