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

[abaine at common-lisp.net]

Author: abaine
Date: Sat Aug 18 19:43:06 2007
New Revision: 143

Modified:
   trunk/funds/src/examples/sudoku.lisp
Log:
Improved solver.

Modified: trunk/funds/src/examples/sudoku.lisp
==============================================================================
--- trunk/funds/src/examples/sudoku.lisp	(original)
+++ trunk/funds/src/examples/sudoku.lisp	Sat Aug 18 19:43:06 2007
@@ -52,25 +52,14 @@
   (fill-falses (set-to-true puzzle i j k) i j k))
 
 (defun fill-falses (puzzle i j k)
-  (fill-falses-row 
-   (fill-falses-column 
-    (fill-falses-number 
-     (fill-falses-box puzzle i j k)
-     i j k)
-    i j k)
-   i j k))
-
-(defun fill-falses-row (puzzle i j k)
-  (fill-falses-group puzzle #'row-coordinates i j k)  )
-
-(defun fill-falses-column (puzzle i j k)
-  (fill-falses-group puzzle #'column-coordinates i j k))
-
-(defun fill-falses-number (puzzle i j k)
-  (fill-falses-group puzzle #'number-coordinates i j k))
-
-(defun fill-falses-box (puzzle i j k)
-  (fill-falses-group puzzle #'box-coordinates i j k))
+  (let ((b (box-number puzzle i j)))
+    (reduce #'(lambda (p group)
+		(apply #'fill-falses-group-2 p group))
+	    (list (list #'i-j-k-coordinates i j)
+		  (list #'j-k-i-coordinates j k)
+		  (list #'i-k-j-coordinates i k)
+		  (list #'b-k-x-coordinates b k))
+	    :initial-value puzzle)))
 
 (defun fill-falses-group (puzzle c-function i j k)
   (let ((size (puzzle-size puzzle)))
@@ -97,27 +86,6 @@
 		      (1+ z)))))
       (f puzzle 0))))
 
-(defun box-coordinates (i j k x size)
-(let ((order (order size)))
-  (values (+ (* order (floor i order))
-	     (floor x order))
-	  (+ (* order (floor j order))
-	     (mod x order))
-	  k)))
-
-
-(defun row-coordinates (i j k x size)
-  (declare (ignore i size))
-  (values x j k))
-
-(defun column-coordinates (i j k x size)
-  (declare (ignore j size))
-  (values i x k))
-
-(defun number-coordinates (i j k x size)
-  (declare (ignore k size))
-  (values i j x))
-
 (defun set-to-true (puzzle i j k)
   (set-value puzzle i j k +true+))