Author: abaine Date: Thu Aug 16 23:41:22 2007 New Revision: 137
Added: trunk/funds/src/examples/funds-examples.asd trunk/funds/src/examples/package.lisp Modified: trunk/funds/src/examples/sudoku.lisp trunk/funds/src/funds.asd Log: Improved example.
Added: trunk/funds/src/examples/funds-examples.asd ============================================================================== --- (empty file) +++ trunk/funds/src/examples/funds-examples.asd Thu Aug 16 23:41:22 2007 @@ -0,0 +1,15 @@ + +;;;; -*- Lisp -*- + +(in-package :cl-user) + +(defpackage #:funds-examples-asd + (:use :cl :asdf)) + +(in-package :funds-examples-asd) + +(defsystem funds-examples + :serial t + :components ((:file "package") + (:file "sudoku")) + :depends-on (:iterate :funds))
Added: trunk/funds/src/examples/package.lisp ============================================================================== --- (empty file) +++ trunk/funds/src/examples/package.lisp Thu Aug 16 23:41:22 2007 @@ -0,0 +1,5 @@ + +(in-package :cl-user) + +(defpackage :funds-examples + (:use :funds :iterate)) \ No newline at end of file
Modified: trunk/funds/src/examples/sudoku.lisp ============================================================================== --- trunk/funds/src/examples/sudoku.lisp (original) +++ trunk/funds/src/examples/sudoku.lisp Thu Aug 16 23:41:22 2007 @@ -145,66 +145,58 @@ (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))))))) + (t (multiple-value-call #'solve-by-group + puzzle (most-constrained-group)))))
(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 ))))) -)))) - - + (let ((best-c #'i-j-k-coordinates) + (best-x -1) + (best-y -1) + (size (puzzle-size puzzle)) + (least-n nil)) + (loop :for x :below size :do + (loop :for y :below size :do + (loop :for c-function :in '(#'i-j-k-coordinates + #'j-k-i-coordinates + #'k-i-j-coordinates + #'b-n-i-coordinates) + :do (let ((n (loop :for z :below size :count + (unknown-p (multiple-value-call + #'puzzle-elt + (c-function x y z size)))))) + (if (< n least-n) + (setf best-c c-function + best-x x + best-y y)))))) + (values best-c best-x best-y))) + +(defun solve-by-group (puzzle c-function x y) + (let ((size (pussle-size puzzle))) + (labels ((f (puzzle z) + (if (= index size) + nil + (multiple-value-bind (i j k) (funcall c-function x y z size) + (if (solved-p (puzzle-elt puzzle i j k)) + (f puzzle (1+ z)) + (or (solve (set-to-true puzzle x y z)) + (f (set-to-false puzzle i j k) (1+ z)))))))))))
+(defun i-j-k-coordinates (i j k size) + (declare (ignore size)) + (values i j k))
-(defun i-j-k-coordinates (i j k) +(defun j-k-i-coordinates (j k i size) + (declare (ignore size)) (values i j k))
-(defun j-k-i-coordinates (j k i) +(defun k-i-j-coordinates (k i j size) + (declare (ignore size)) (values i j k))
-(defun k-i-j-coordinates (k i j) - (values i j k)) \ No newline at end of file +(defun b-n-i-coordinates (box number index size) + (let ((order (order size))) + (values (+ (* order (floor box order)) + (floor index order)) + (+ (* order (mod box order)) + (mod index order)) + number)))
Modified: trunk/funds/src/funds.asd ============================================================================== --- trunk/funds/src/funds.asd (original) +++ trunk/funds/src/funds.asd Thu Aug 16 23:41:22 2007 @@ -51,4 +51,3 @@ (:file "f-array") (:file "dictionary") (:file "queue"))) -