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

[abaine at common-lisp.net]

Author: abaine
Date: Wed Aug 15 23:28:16 2007
New Revision: 136

Modified:
   trunk/funds/src/examples/sudoku.lisp
Log:
Closer to working solver.

Modified: trunk/funds/src/examples/sudoku.lisp
==============================================================================
--- trunk/funds/src/examples/sudoku.lisp	(original)
+++ trunk/funds/src/examples/sudoku.lisp	Wed Aug 15 23:28:16 2007
@@ -104,7 +104,6 @@
     (+ (start j order)
      (mod index order))))
 
-
 (defun start (x order)
   (* order (floor x order)))
 
@@ -142,3 +141,70 @@
 		(+ (* order (mod box order))
 		   (mod index order))
 		number)))
+
+(defun solve (puzzle)
+  (cond ((complete-p puzzle) puzzle)
+	((not (solvable-p puzzle)) nil)
+	(t (multiple-value-bind (x y z) (most-constrained-coordinates puzzle)
+	     (or (solve (set-to-true puzzle x y z))
+		 (solve (set-to-false puzzle x y z)))))))
+
+(defun most-constrained-coordinates (puzzle)
+  (let* ((best-i -1)
+	 (best-j -1)
+	 (best-k -1)
+	 (size (puzzle-size puzzle))
+	 (best-n (1+ size)))
+    (loop for i below size do
+	  when 
+	  finally (return (values best-i best-j best-k)))))
+
+
+
+(defun solve-row (puzzle j k)
+  (let ((size (puzzle-size puzzle)))
+    (labels ((f (puzzle i)
+	       (cond ((= i size) nil)
+		     ((solved-p (puzzle-elt puzzle i j k) (f puzzle (1+ i))))
+		     (t (or (solve (set-to-true puzzle i j k))
+			    (f (set-to-false puzzle i j k) (1+ i)))))))
+      (f puzzle 0))))
+
+(defun solve-column (puzzle i k)
+  (let ((size (puzzle-size puzzle)))
+    (labels ((f (puzzle j)
+	       (cond ((= j size) nil)
+		     ((solved-p (puzzle-elt puzzle i j k)) (f puzzle (1+ j)))
+		     (t (or (solve (set-to-true puzzle i j k))
+			    (f (set-to-false puzzle i j k) (1+ j)))))))
+      (f puzzle 0))))
+
+(defun solve-number (puzzle i j)
+  (let ((size (puzzle-size puzzle)))
+   (labels ((f (puzzle k)
+	      (cond ((= k size) nil)
+		    ((solved-p (puzzle-elt puzzle i j k)) (f puzzle (1+ k))
+		     (t (or (solve (set-to-true puzzle i j k))
+			    (f (set-to-false puzzle i j k) (1+ k))))))))
+     (f puzzle 0))))
+
+(defun solve-box (puzzle box number)
+  (let ((size (puzzle-size puzzle)))
+    (labels ((f (puzzle index)
+	       (cond ((= index size)nil)
+		     ((solved-p (puzzle-elt-by-box puzzle box number index)
+				(f (puzzle 1+ index)))
+		      (t (or solve )))))
+))))
+
+
+
+
+(defun i-j-k-coordinates (i j k)
+  (values i j k))
+
+(defun j-k-i-coordinates (j k i)
+  (values i j k))
+
+(defun k-i-j-coordinates (k i j)
+  (values i j k))
\ No newline at end of file