111 lines
3.6 KiB
Common Lisp
111 lines
3.6 KiB
Common Lisp
(defvar *map* (make-array '(9 9)))
|
|
|
|
(defun get-row (map x)
|
|
"Returns a list of all values present in row x of map"
|
|
(let ((row nil))
|
|
(loop for i from 0 to 8 do
|
|
(setf row (cons (aref map x i) row)))
|
|
(remove-if (lambda (e) (= e 0)) row)))
|
|
|
|
(defun get-col (map y)
|
|
"Returns a list of all values in column y of map"
|
|
(let ((col nil))
|
|
(loop for i from 0 to 8 do
|
|
(setf col (cons (aref map i y) col)))
|
|
(remove-if (lambda (e) (= e 0)) col)))
|
|
|
|
(defun get-zone (map x y)
|
|
"Returns a list of all values for the zone which contains cell x,y."
|
|
(let ((zone nil)
|
|
(zx (* 3 (floor (/ x 3))))
|
|
(zy (* 3 (floor (/ y 3)))))
|
|
(loop for i from 0 to 2 do
|
|
(loop for j from 0 to 2 do
|
|
(setf zone (cons (aref map (+ zx i) (+ zy j)) zone))))
|
|
(remove-if (lambda (e) (= e 0)) zone)))
|
|
|
|
(defun get-valid-for-pos (map x y)
|
|
"Returns the list of presently-valid remaining values for cell x,y in map"
|
|
(if (= 0 (aref map x y))
|
|
(let ((row (get-row map x))
|
|
(col (get-col map y))
|
|
(zone (get-zone map x y))
|
|
(valid '(1 2 3 4 5 6 7 8 9)))
|
|
(setf valid (set-difference valid row))
|
|
(setf valid (set-difference valid col))
|
|
(set-difference valid zone))))
|
|
|
|
(defun get-min-move-count (map)
|
|
"Returns the cell coordinates in list form '(x y) for the cell with the lowest number of presently-valid remaining values. It also returns the count of this quantity"
|
|
(let ((min-move-count 10)
|
|
(min-move-coords nil))
|
|
(loop for i from 0 to 8 do
|
|
(loop for j from 0 to 8 do
|
|
(let ((move-count (length (aref map i j))))
|
|
(if (and (not (= move-count 0)) (< move-count min-move-count))
|
|
(progn
|
|
(setf min-move-count move-count)
|
|
(setf min-move-coords (list i j)))))))
|
|
(values min-move-coords min-move-count)))
|
|
|
|
(defun build-move-map (map)
|
|
"Returns an array where each cell contains a list of values which are presently-valid for map"
|
|
(let ((move-map (make-array '(9 9))))
|
|
(loop for i from 0 to 8 do
|
|
(loop for j from 0 to 8 do
|
|
(setf (aref move-map i j) (get-valid-for-pos map i j))))
|
|
move-map))
|
|
|
|
(defun map-complete (map)
|
|
"Checks whether all cells are filled with a non-zero value in map"
|
|
(loop for i from 0 to 8 do
|
|
(loop for j from 0 to 8 do
|
|
(if (= 0 (aref map i j))
|
|
(return-from map-complete nil))))
|
|
t)
|
|
|
|
(defun copy-array (arr)
|
|
"Creates a value copy of an array, assumes 9 x 9 dimensions"
|
|
(let ((arr2 (make-array '(9 9))))
|
|
(loop for i from 0 to 8 do
|
|
(loop for j from 0 to 8 do
|
|
(setf (aref arr2 i j) (aref arr i j))))
|
|
arr2))
|
|
|
|
(defun solve-map-r (map)
|
|
"Resursive solver for a sudoku puzzle map, saves result to global *map*"
|
|
(let ((move-map (build-move-map map))
|
|
(mapc (copy-array map))
|
|
(min-move nil))
|
|
(setf min-move (get-min-move-count move-map))
|
|
(if (equal nil min-move)
|
|
(if (map-complete mapc)
|
|
(progn
|
|
(setf *map* mapc)
|
|
(return-from solve-map-r t))
|
|
(return-from solve-map-r nil)))
|
|
(loop for val in (aref move-map (first min-move) (second min-move)) do
|
|
(setf (aref mapc (nth 0 min-move) (nth 1 min-move)) val)
|
|
(if (solve-map-r mapc)
|
|
(return-from solve-map-r t))))
|
|
nil)
|
|
|
|
(defun solve-map (map)
|
|
"Wrapper function for recursive solver. Returns value *map* saved by solver"
|
|
(if (solve-map-r map)
|
|
*map*
|
|
nil))
|
|
|
|
|
|
(defun build-map (strlst)
|
|
"Builds a map array from a list of strings. Expects 9 strings of 9 characters each"
|
|
(let ((map (make-array '(9 9)))
|
|
(row 0))
|
|
(loop for str in strlst do
|
|
(loop for i from 0 to 8 do
|
|
(setf (aref map row i) (digit-char-p (aref str i))))
|
|
(setf row (1+ row)))
|
|
map))
|
|
|
|
; example:
|
|
(solve-map (build-map '("003020600" "900305001" "001806400" "008102900" "700000008" "006708200" "002609500" "800203009" "005010300"))) |