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

[abaine at common-lisp.net]

Author: abaine
Date: Sat Aug 18 18:56:29 2007
New Revision: 141

Modified:
   trunk/funds/src/examples/sudoku.lisp
Log:
Minor changes to solver.

Modified: trunk/funds/src/examples/sudoku.lisp
==============================================================================
--- trunk/funds/src/examples/sudoku.lisp	(original)
+++ trunk/funds/src/examples/sudoku.lisp	Sat Aug 18 18:56:29 2007
@@ -60,8 +60,6 @@
     i j k)
    i j k))
 
-
-
 (defun fill-falses-row (puzzle i j k)
   (fill-falses-group puzzle #'row-coordinates i j k)  )
 
@@ -137,21 +135,25 @@
 					     "")))))))))
 
 (defun solve (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)))))
+  (if (complete-p puzzle)
+      (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))
@@ -204,9 +206,6 @@
 	  (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)))
@@ -220,6 +219,12 @@
 		    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)))))))
+
 (defun enlarge-zero (count size)
   (if (zerop count)
       (1+ size)
@@ -237,43 +242,58 @@
 (defun solve-box (puzzle b k)
   (solve-group puzzle #'b-k-x-coordinates b k))
 
-(defun solve-group (puzzle c-function x y)
-  (if (complete-p puzzle)
-      puzzle
-      (let ((size (puzzle-size puzzle)))  
-	(labels ((f (z)
-		   (if  (= z size) nil
-			(multiple-value-bind (i j k)
-			    (funcall c-function x y z puzzle)
-			  (if (puzzle-elt-solved puzzle i j k)
-			      (f (1+ z))
-			      (or (solve (multiple-value-call
-					     #'fill-true puzzle
-					     (funcall c-function x y z puzzle)))
-				  (f (1+ z))))))))
+(defun solve-group (puzzle x-y-z-function x y)
+  (let ((size (puzzle-size puzzle)))  
+    (labels ((f (z)
+	       (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)
+			  (f (1+ z))
+			  (or (solve (fill-true puzzle i j k))
+			      (f (1+ z))))))))
       
-	  (f 0)))))
+      (f 0))))
 
 (defun complete-p (puzzle)
   (= (tree-weight (puzzle-tree puzzle))
      (round (expt (puzzle-size puzzle) 3))))
 
-(defun i-j-k-coordinates (i j k puzzle)
-  (declare (ignore puzzle))
+(defun solved-p (puzzle)
+  (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)))))))))
+
+(defun i-j-k-coordinates (i j k size)
+  (declare (ignore size))
   (values i j k))
 
-(defun i-k-j-coordinates (i k j puzzle)
-  (declare (ignore puzzle))
+(defun i-k-j-coordinates (i k j size)
+  (declare (ignore size))
   (values i j k))
 
-(defun j-k-i-coordinates (j k i puzzle)
-  (declare (ignore puzzle))
+(defun j-k-i-coordinates (j k i size)
+  (declare (ignore size))
   (values i j k))
 
-(defun b-k-x-coordinates (b k x puzzle)
-  (let ((order (order (puzzle-size puzzle))))
+(defun b-k-x-coordinates (b k x size)
+  (let ((order (order size)))
     (values (+ (* order (floor b order))
 	       (floor x order))
 	    (+ (* order (mod b order))
 	       (mod x order))
-	    k)))
\ No newline at end of file
+	    k)))
+
+(defun group-solved (puzzle x-y-z-function x y)
+  (let ((size (puzzle-size puzzle)))
+    (= 1 (iter (for z below size)
+	       (count (elt-true-p (multiple-value-call
+				      #'puzzle-elt puzzle
+				      (funcall x-y-z-function x y z size))))))))
+