Author: abaine Date: Sat Aug 18 20:19:01 2007 New Revision: 144

Modified: trunk/funds/src/examples/sudoku.lisp Log: Solver's getting good.

Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sat Aug 18 20:19:01 2007 @@ -122,40 +122,19 @@ (if (solved-p puzzle) puzzle nil) - (iter (for f in (list #'best-row - #'best-column - #'best-number - #'best-box)) - (for s in (list #'solve-row - #'solve-column - #'solve-number - #'solve-box)) - (for (values x y n) = (funcall f puzzle)) - (finding x minimizing n into best-x) - (finding y minimizing n into best-y) - (finding s minimizing n into (best-s min)) - (when (= min 1) - (return (funcall best-s puzzle best-x best-y))) - (finally (return (funcall best-s puzzle best-x best-y)))))) - -(defun best-row (puzzle) - (best-group puzzle #'row-freedom)) - -(defun best-column (puzzle) - (best-group puzzle #'column-freedom)) + (iter (for f in x-y-z-functions) + (for (values x y n) = (best-group puzzle f)) + (finding (list f x y) minimizing n into (best-list min)) + (when (= min 1) + (return (apply #'solve-group puzzle best-list))) + (finally (return (apply #'solve-group puzzle best-list))))))

-(defun best-number (puzzle) - (best-group puzzle #'number-freedom)) - -(defun best-box (puzzle) - (best-group puzzle #'box-freedom)) - -(defun best-group (puzzle freedom-function) +(defun best-group (puzzle x-y-z-function) (let ((size (puzzle-size puzzle))) (iter (for x below size) (for (values y n) = (iter (for y below size) - (for n = (funcall freedom-function puzzle x y)) + (for n = (group-freedom puzzle x-y-z-function x y)) (finding y minimizing n into (best-y min)) (when (= min 1) (return (values best-y min))) @@ -166,65 +145,19 @@ (return (values best-x best-y best-n))) (finally (return (values best-x best-y best-n))))))

-(defun row-freedom (puzzle i k) - (let ((size (puzzle-size puzzle))) - (iter (for j below size) - (counting (elt-unknown-p (puzzle-elt puzzle i j k)) into c) - (finally (return (enlarge-zero c size) ))))) - - - - -(defun column-freedom (puzzle j k) - (let ((size (puzzle-size puzzle))) - (iter (for i below size) - (counting (elt-unknown-p (puzzle-elt puzzle i j k)) into c) - (finally (return (enlarge-zero c size)))))) - - - -(defun number-freedom (puzzle i j) - (let ((size (puzzle-size puzzle))) - (iter (for k below size) - (counting (elt-unknown-p (puzzle-elt puzzle i j k)) into c) - (finally (return (enlarge-zero c size)))))) - -(defun box-freedom (puzzle b k) - (let* ((size (puzzle-size puzzle)) - (order (order size))) - (iter (for x below size) - (counting (elt-unknown-p (puzzle-elt puzzle - (+ (* order (floor b order)) - (floor x order)) - (+ (* order (mod b order)) - (mod x order)) - k)) - into c) - (finally (return (enlarge-zero c size)))))) - (defun group-freedom (puzzle x-y-z-function x y) (let ((size (puzzle-size puzzle))) - (iter (for z below size) - (counting (elt-unknown-p (multiple-value-call #'puzzle-elt puzzle - (funcall x-y-z-function x y z size))))))) + (enlarge-zero + (iter (for z below size) + (counting (elt-unknown-p (multiple-value-call #'puzzle-elt puzzle + (funcall x-y-z-function x y z size))))) + size)))

(defun enlarge-zero (count size) (if (zerop count) (1+ size) count))

-(defun solve-row (puzzle i k) - (solve-group puzzle #'i-k-j-coordinates i k)) - -(defun solve-column (puzzle j k) - (solve-group puzzle #'j-k-i-coordinates j k)) - -(defun solve-number (puzzle i j) - (solve-group puzzle #'i-j-k-coordinates i j)) - -(defun solve-box (puzzle b k) - (solve-group puzzle #'b-k-x-coordinates b k)) - (defun solve-group (puzzle x-y-z-function x y) (let ((size (puzzle-size puzzle))) (labels ((f (z) @@ -246,12 +179,8 @@ (let ((size (puzzle-size puzzle))) (iter (for x below size) (always (iter (for y below size) - (always (iter (for x-y-z-function in (list - #'i-j-k-coordinates - #'i-k-j-coordinates - #'j-k-i-coordinates - #'b-k-x-coordinates)) - (always (group-solved puzzle x-y-z-function x y))))))))) + (always (iter (for f in x-y-z-functions) + (always (group-solved puzzle f x y)))))))))

(defun i-j-k-coordinates (i j k size) (declare (ignore size)) @@ -279,3 +208,23 @@ (count (elt-true-p (multiple-value-call #'puzzle-elt puzzle (funcall x-y-z-function x y z size)))))))) + +(defun puzzle-solvable (puzzle) + (let ((size (puzzle-size puzzle))) + (iter (for f in x-y-z-functions) + (always (iter (for x below size) + (always (iter (for y below size) + (always (group-solvable puzzle f x y))))))))) + +(defun group-solvable (puzzle x-y-z-function x y) + (let ((size (puzzle-size puzzle))) + (iter (for z below size) + (for elt = (multiple-value-call #'puzzle-elt + puzzle (funcall x-y-z-function x y z size))) + (thereis (or (elt-unknown-p elt) + (elt-true-p elt)))))) + +(defvar x-y-z-functions (list #'i-j-k-coordinates + #'i-k-j-coordinates + #'j-k-i-coordinates + #'b-k-x-coordinates))