author Robert Strandh Mon, 19 Apr 2010 12:37:51 +0000 (14:37 +0200) committer Robert Strandh Mon, 19 Apr 2010 12:37:51 +0000 (14:37 +0200)
 sudoku-algorithm.lisp patch | blob | blame | history

index 8c97c91..95ee0ad 100644 (file)
@@ -40,7 +40,7 @@
;;; return a true value if and only if there is more than one
;;; possible value for the cell.
(defun check-hole (cell)
-  (/= (symbolset-cardinality (possibilities cell)) 1)
+  (/= (symbolset-cardinality (possibilities cell)) 1))

(defun find-possibilities (cell)
(let* ((leng (length (possibilities cell)))
repeat sqrt-board-width
do (loop for col from 0 below board-width
do (setf (aref board row col)
-                                    (mod (+ col offset1 offset2) board-width)))))
+                                    (mod (+ col offset1 offset2)
+                                          board-width)))))
(return-from create-initial-board board)))

;;; Exchange two non-overlapping rectangles having the same shape
-(defun exchange-rectangles (board start-row-1 start-col-1 height width start-row-2 start-col-2)
+(defun exchange-rectangles (board
+                            start-row-1 start-col-1
+                            height width
+                            start-row-2 start-col-2)
(unless (and (= start-row-1 start-row-2) (= start-col-1 start-col-2))
(loop for row-1 from start-row-1
for row-2 from start-row-2
(sqrt-board-width (isqrt board-width)))
(exchange-rectangles board 0 col-1 board-width sqrt-board-width 0 col-2)))

+;;; This function computes a random permutation of n elements.  It
+;;; works as follows: At each iteration, there is a prefix of i random
+;;; elements (initially 0) , and another element of the prefix is
+;;; computed by exchanging element i and a random element among the
+;;; elements from i to n-1 inclusive.  There are n-i [(n-1) - i + 1]
+;;; such elements, so the RANDOM function has to be called with n-i,
+;;; which gives us a value between 0 and n-i-1 inclusive.  By adding i
+;;; to that value, we get a value between i and n-1 inclusive.
+;;; Instead of stipulating how the elements are stored, we take as an
+;;; argument an exchange function that is called with i and the
+;;; element number of the element to exchange with element i.  This function
+;;; is responsible for accessing the exact physical representation of the n
+;;; elements.
(defun compute-random-permutation (n exchange-fun)
(loop for i from 0 to (- n 2)
do (let ((e (+ i (random (- n i)))))
(unless (= i e)
(funcall exchange-fun i e)))))

+;;; To shuffle a vector, compute a random permutation
+;;; of its elements.
(defun shuffle-vector (vector)
-  (let ((N (length vector)))
-    (compute-random-permutation
-     N (lambda (i j) (rotatef (aref vector i) (aref vector j))))))
+  (compute-random-permutation
+   (length vector)
+   (lambda (i j)
+     (rotatef (aref vector i) (aref vector j)))))

(defun shuffle-rows-within-block (board block-start)
(let ((N (isqrt (array-dimension board 0))))
(compute-random-permutation
-     N (lambda (r1 r2) (exchange-rows board (+ block-start r1) (+ block-start r2))))))
+     N (lambda (r1 r2)
+         (exchange-rows board (+ block-start r1) (+ block-start r2))))))

(defun shuffle-columns-within-block (board block-start)
(let ((N (isqrt (array-dimension board 0))))
(compute-random-permutation
-     N (lambda (c1 c2) (exchange-columns board (+ block-start c1) (+ block-start c2))))))
+     N (lambda (c1 c2)
+         (exchange-columns board (+ block-start c1) (+ block-start c2))))))

(defun shuffle-blocks-of-rows (board)
(let ((N (isqrt (array-dimension board 0))))
(compute-random-permutation
-     N (lambda (r1 r2) (exchange-blocks-of-rows board (* r1 N) (* r2 N))))))
+     N (lambda (r1 r2)
+         (exchange-blocks-of-rows board (* r1 N) (* r2 N))))))

(defun shuffle-blocks-of-columns (board)
(let ((N (isqrt (array-dimension board 0))))
(compute-random-permutation
-     N (lambda (c1 c2) (exchange-blocks-of-columns board (* c1 N) (* c2 N))))))
+     N (lambda (c1 c2)
+         (exchange-blocks-of-columns board (* c1 N) (* c2 N))))))

(defun shuffle-board (board)
(let* ((board-width (array-dimension board 0))
for value = (aref used-board row col)
do (when (> value 0)
(erase-possibilities (aref (cells game) row col))
-                       (set-possibilities (aref (cells game) row col) (- value 1) 1))))))
+                       (set-possibilities (aref (cells game) row col)
+                                           (- value 1) 1))))))

(defun create-game (board)
(let* ((board-width (array-dimension board 0))
;; Create an array of cell instances
(loop for row from 0 below board-width
do (loop for col from 0 below board-width
-                  do (setf (aref (cells game) row col) (make-cell board-width))))
+                  do (setf (aref (cells game) row col)
+                            (make-cell board-width))))
;; Initiate values for all cells of game
;; We will replace this call by the function which finds a game
(set-sample-game game)
(loop for row from 0 below board-width by sqrt-board-width
do (loop for col from 0 below board-width by sqrt-board-width
do (let ((unit (make-unit)))
-                       (copy-rectangle-to-unit game row sqrt-board-width col sqrt-board-width unit)
+                       (copy-rectangle-to-unit
+                         game row sqrt-board-width col sqrt-board-width unit)
(push unit (units game))