(eval-when (:compile-toplevel :load-toplevel)
(require :screamer))
(in-package :screamer-user)
(defun var-integer-list (count min max)
(loop for i below count
collect (an-integer-betweenv min max)))
(defun all-differentv (x &rest xs)
(labels ((all-different (x xs)
(if (null xs)
t
(andv (notv (=v x (car xs)))
(all-different x (cdr xs))
(all-different (car xs) (cdr xs))))))
(all-different x xs)))
(defun chunk (size list)
(declare (type (integer 0 *) size))
(let (chunks)
(loop for l = list then (subseq l size)
while l do (push (subseq l 0 size) chunks)
finally (return (nreverse chunks)))))
(defun matrix-transpose (matrix)
(when matrix
(apply #'mapcar #'list matrix)))
(defun rows (list &optional (size 9))
(chunk size list))
(defun columns (list &optional (size 9))
(matrix-transpose (chunk size list)))
(defun boxes (list &optional (size 3))
(flet ((flatten (list)
(apply #'append list)))
(flatten (mapcar (lambda (x)
(mapcar #'flatten
(matrix-transpose x)))
(chunk size
(chunk size
(chunk size
list)))))))
(defparameter *sudoku-problem-1*
'(_ _ 8 _ _ _ 6 _ _
_ 4 _ 9 _ 2 _ 5 _
_ _ _ 6 4 8 _ _ _
_ 3 9 _ 2 _ 1 7 _
_ 1 _ _ _ _ _ 3 _
_ 8 5 _ 1 _ 2 6 _
_ _ _ 2 8 7 _ _ _
_ 6 _ 1 _ 4 _ 8 _
_ _ 2 _ _ _ 5 _ _))
(defparameter *sudoku-problem-2*
'(_ 2 6 _ _ _ 8 1 _
3 _ _ 7 _ 8 _ _ 6
4 _ _ _ 5 _ _ _ 7
_ 5 _ 1 _ 7 _ 9 _
_ _ 3 9 _ 5 1 _ _
_ 4 _ 3 _ 2 _ 5 _
1 _ _ _ 3 _ _ _ 2
5 _ _ 2 _ 4 _ _ 9
_ 3 8 _ _ _ 4 6 _))
(defparameter *sudoku-problem-3*
'(_ _ 2 3 _ _ 7 _ _
_ _ 4 _ _ 9 _ _ _
6 _ _ _ _ _ _ 5 _
_ 7 _ _ _ 2 _ 6 _
_ _ 3 7 _ _ 4 _ _
_ 1 _ _ _ _ _ 2 _
_ 3 _ _ _ _ _ _ 9
_ _ _ 4 _ _ 6 _ _
_ _ 5 _ _ 8 2 _ _))
(defun sudoku (grid)
(let ((vars (mapcar (lambda (x)
(if (numberp x)
x
(an-integer-betweenv 1 9)))
grid)))
(one-value
(solution
(dolist (list (append (rows vars)
(columns vars)
(boxes vars))
vars)
(assert! (apply 'all-differentv list)))
(reorder #'domain-size
#'(lambda (x) (declare (ignore x)) nil)
#'<
#'linear-force)))))
(defun run ()
(loop repeat 1
do (sudoku *sudoku-problem-1*)
(sudoku *sudoku-problem-2*)
(sudoku *sudoku-problem-3*)))