Author: abaine Date: Sat Aug 18 21:02:29 2007 New Revision: 145
Modified: trunk/funds/src/examples/sudoku.lisp Log: Good solver.
Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Sat Aug 18 21:02:29 2007 @@ -8,18 +8,8 @@ size tree)
-(defun puzzle-find (puzzle i j k) - (multiple-value-bind (v found) - (tree-find (puzzle-tree puzzle) (index i j k (puzzle-size puzzle))) - (values v found))) - -(defun puzzle-elt-solved (puzzle i j k) - (multiple-value-bind (v found) - (puzzle-find puzzle i j k) - found)) - (defun puzzle-elt (puzzle i j k) - (puzzle-find puzzle i j k)) + (tree-find (puzzle-tree puzzle) (index i j k (puzzle-size puzzle))))
(defun elt-true-p (elt) (and elt (= elt +true+))) @@ -48,6 +38,24 @@ (return (1+ k))) (finally (return 0)))))))))
+(defun puzzle-complete-p (puzzle) + (= (tree-weight (puzzle-tree puzzle)) + (round (expt (puzzle-size puzzle) 3)))) + +(defun puzzle-solved-p (puzzle) + (let ((size (puzzle-size puzzle))) + (iter (for x below size) + (always (iter (for y below size) + (always (iter (for f in x-y-z-functions) + (always (group-solved puzzle f x y))))))))) + +(defun puzzle-solvable-p (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 fill-true (puzzle i j k) (fill-falses (set-to-true puzzle i j k) i j k))
@@ -118,16 +126,16 @@ "")))))))))
(defun solve (puzzle) - (if (complete-p puzzle) - (if (solved-p puzzle) + (if (puzzle-solvable-p puzzle) + (if (puzzle-complete-p puzzle) puzzle - nil) - (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)))))) + (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))))) + nil))
(defun best-group (puzzle x-y-z-function) (let ((size (puzzle-size puzzle))) @@ -164,24 +172,12 @@ (if (= z size) nil (multiple-value-bind (i j k) (funcall x-y-z-function x y z size) - (if (puzzle-elt-solved puzzle i j k) + (if (puzzle-elt puzzle i j k) (f (1+ z)) (or (solve (fill-true puzzle i j k)) (f (1+ z)))))))) - (f 0))))
-(defun complete-p (puzzle) - (= (tree-weight (puzzle-tree puzzle)) - (round (expt (puzzle-size puzzle) 3)))) - -(defun solved-p (puzzle) - (let ((size (puzzle-size puzzle))) - (iter (for x below size) - (always (iter (for y below size) - (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)) (values i j k)) @@ -209,13 +205,6 @@ #'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)