[funds-cvs] r139 - trunk/funds/src/examples

[abaine at common-lisp.net]

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))