-
Notifications
You must be signed in to change notification settings - Fork 0
/
sudoku.lisp
110 lines (95 loc) · 3.17 KB
/
sudoku.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
(defpackage :sudoku
(:use :cl))
(in-package :sudoku)
(defun make-grid (contents)
(make-array '(9 9) :initial-contents contents))
(defun clone-grid (old)
(alexandria:copy-array old))
(defun at (grid row col)
(aref grid row col))
(defun (setf at) (digit grid row col)
(setf (aref grid row col) digit))
(defun row-digits (grid row)
(let (digits)
(dotimes (col 9 digits)
(unless (zerop (at grid row col))
(push (at grid row col) digits)))))
(defun col-digits (grid col)
(let (digits)
(dotimes (row 9 digits)
(unless (zerop (at grid row col))
(push (at grid row col) digits)))))
(defun box-digits (grid box-number)
(multiple-value-bind (row-offset col-offset) (floor box-number 3)
(loop with col-offset = (* 3 col-offset)
with row-offset = (* 3 row-offset)
for col from col-offset below (+ col-offset 3)
nconc (loop for row from row-offset below (+ row-offset 3)
for digit = (at grid row col)
unless (zerop digit)
collect digit))))
(defun row-col-to-box (row col)
(+ (* (floor row 3) 3)
(floor col 3)))
(defun digits-possible-at (grid row col)
(set-difference '(1 2 3 4 5 6 7 8 9)
(append (row-digits grid row)
(col-digits grid col)
(box-digits grid (row-col-to-box row col)))))
(defmacro do-unknowns ((row col box grid) &body body)
`(dotimes (,row 9)
(dotimes (,col 9)
(when (zerop (at ,grid ,row ,col))
(let ((,box (row-col-to-box ,row ,col)))
(declare (ignorable ,box))
,@body)))))
(define-condition not-possible (error)
())
(defun scan (grid)
(let (min
row-min
col-min
possible-min
(changed t))
(loop
(unless changed
(return-from scan (list row-min col-min possible-min)))
(setf changed nil
row-min nil
col-min nil
possible-min nil
min 10)
(do-unknowns (row col box grid)
(let ((possible (digits-possible-at grid row col)))
(cond
((null possible)
(error 'not-possible))
((null (cdr possible))
(setf (at grid row col) (first possible)
changed t))
(t
(when (and (null changed)
(< (length possible) min))
(setf min (length possible)
row-min row
col-min col
possible-min possible)))))))))
(defun solve (grid)
(let ((grid (clone-grid grid)))
(destructuring-bind (row col possible) (scan grid)
(unless row
(return-from solve grid))
(dolist (digit possible)
(setf (at grid row col) digit)
(handler-case
(return-from solve (solve grid))
(not-possible ()
; catch and try next
)))
(error 'not-possible))))
(defun print-grid (grid)
(dotimes (row 9)
(format t "~{~A ~A ~A | ~A ~A ~A | ~A ~A ~A~}~%"
(loop for col below 9 collect (at grid row col)))
(when (member row '(2 5))
(format t "------+-------+-------~%"))))