Author: abaine Date: Sat Aug 18 01:45:36 2007 New Revision: 139
Modified: trunk/funds/src/examples/sudoku.lisp Log: Continued improving example.
Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sat Aug 18 01:45:36 2007 @@ -27,6 +27,9 @@ (defun elt-false-p (elt) (and elt (= elt +false+)))
+(defun elt-unknown-p (elt) + (null elt)) + (defun puzzle-from-list (list-rep) (labels ((f (puzzle list row i j) (cond ((null list) puzzle) @@ -136,4 +139,83 @@ (collect (or (puzzle-elt puzzle i j k) "")))))))))
+(defun best-solver (puzzle) + (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)) + +(defun best-number (puzzle) + (best-group puzzle #'number-freedom)) + +(defun best-box (puzzle) + (best-group puzzle #'box-freedom)) + +(defun best-group (puzzle freedom-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)) + (finding y minimizing n into (best-y min)) + (when (= min 1) + (return (values best-y min))) + (finally (return (values best-y min))))) + (finding x minimizing n into best-x) + (finding y minimizing n into (best-y best-n)) + (when (= best-n 1) + (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 enlarge-zero (count size) + (if (zerop count) + (1+ size) + count))