Data commit

Task/Sudoku/Common-Lisp/sudoku.lisp

@@ -0,0 +1,40 @@
+(defun row-neighbors (row column grid &aux (neighbors '()))
+  (dotimes (i 9 neighbors)
+    (let ((x (aref grid row i)))
+      (unless (or (eq '_ x) (= i column))
+        (push x neighbors)))))
+
+(defun column-neighbors (row column grid &aux (neighbors '()))
+  (dotimes (i 9 neighbors)
+    (let ((x (aref grid i column)))
+      (unless (or (eq x '_) (= i row))
+        (push x neighbors)))))
+
+(defun square-neighbors (row column grid &aux (neighbors '()))
+  (let* ((rmin (* 3 (floor row 3)))    (rmax (+ rmin 3))
+         (cmin (* 3 (floor column 3))) (cmax (+ cmin 3)))
+    (do ((r rmin (1+ r))) ((= r rmax) neighbors)
+      (do ((c cmin (1+ c))) ((= c cmax))
+        (let ((x (aref grid r c)))
+          (unless (or (eq x '_) (= r row) (= c column))
+            (push x neighbors)))))))
+
+(defun choices (row column grid)
+  (nset-difference
+   (list 1 2 3 4 5 6 7 8 9)
+   (nconc (row-neighbors row column grid)
+          (column-neighbors row column grid)
+          (square-neighbors row column grid))))
+
+(defun solve (grid &optional (row 0) (column 0))
+  (cond
+   ((= row 9)
+    grid)
+   ((= column 9)
+    (solve grid (1+ row) 0))
+   ((not (eq '_ (aref grid row column)))
+    (solve grid row (1+ column)))
+   (t (dolist (choice (choices row column grid) (setf (aref grid row column) '_))
+        (setf (aref grid row column) choice)
+        (when (eq grid (solve grid row (1+ column)))
+          (return grid))))))