Author: abaine Date: Sat Aug 18 19:43:06 2007 New Revision: 143
Modified: trunk/funds/src/examples/sudoku.lisp Log: Improved solver.
Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sat Aug 18 19:43:06 2007 @@ -52,25 +52,14 @@ (fill-falses (set-to-true puzzle i j k) i j k))
(defun fill-falses (puzzle i j k) - (fill-falses-row - (fill-falses-column - (fill-falses-number - (fill-falses-box puzzle i j k) - i j k) - i j k) - i j k)) - -(defun fill-falses-row (puzzle i j k) - (fill-falses-group puzzle #'row-coordinates i j k) ) - -(defun fill-falses-column (puzzle i j k) - (fill-falses-group puzzle #'column-coordinates i j k)) - -(defun fill-falses-number (puzzle i j k) - (fill-falses-group puzzle #'number-coordinates i j k)) - -(defun fill-falses-box (puzzle i j k) - (fill-falses-group puzzle #'box-coordinates i j k)) + (let ((b (box-number puzzle i j))) + (reduce #'(lambda (p group) + (apply #'fill-falses-group-2 p group)) + (list (list #'i-j-k-coordinates i j) + (list #'j-k-i-coordinates j k) + (list #'i-k-j-coordinates i k) + (list #'b-k-x-coordinates b k)) + :initial-value puzzle)))
(defun fill-falses-group (puzzle c-function i j k) (let ((size (puzzle-size puzzle))) @@ -97,27 +86,6 @@ (1+ z))))) (f puzzle 0))))
-(defun box-coordinates (i j k x size) -(let ((order (order size))) - (values (+ (* order (floor i order)) - (floor x order)) - (+ (* order (floor j order)) - (mod x order)) - k))) - - -(defun row-coordinates (i j k x size) - (declare (ignore i size)) - (values x j k)) - -(defun column-coordinates (i j k x size) - (declare (ignore j size)) - (values i x k)) - -(defun number-coordinates (i j k x size) - (declare (ignore k size)) - (values i j x)) - (defun set-to-true (puzzle i j k) (set-value puzzle i j k +true+))