Took way too long

p96.lisp

@@ -0,0 +1,88 @@
+;;; Algorithm: Find an empty cell and try all valid digits, then
+;;; recurse (returning early on success and reverting on failure).
+
+(defun make-grid ()
+  "Returns an empty Sudoku grid"
+  (make-array (list 9 9)
+	      :element-type '(unsigned-byte 8)
+	      :initial-element 0))
+
+(defun parse-grid (grid-lines)
+  "Parses text lines representing a Sudoku puzzle, returning a 2D grid of digits"
+  (loop with grid = (make-grid)
+	for line in grid-lines
+	for row from 0 below 9
+	do (loop for column from 0 below 9
+		 for character across line
+		 for value = (digit-char-p character)
+		 do (setf (aref grid row column) value))
+	finally (return grid)))
+
+(defun from-index (index)
+  "Converts a 1D index (e.g. 80) into a row and column (e.g. (VALUES 9 9))"
+  (floor index 9))
+
+(defun find-open-cell (grid start-index)
+  "Returns the row and column of the first open cell in GRID"
+  (loop for index from start-index below 81
+	do (multiple-value-bind (i j) (from-index index)
+	     (when (= 0 (aref grid i j))
+	       (return-from find-open-cell index)))))
+
+(defun compute-invalid (grid i j)
+  "Returns a bit vector of invalid digits"
+  (let ((invalid 0))
+    ;; Check column
+    (loop for ci from 0 below 9
+	  do (setf invalid (logior invalid (ash 1 (aref grid ci j)))))
+    ;; Check row
+    (loop for rj from 0 below 9
+	  do (setf invalid (logior invalid (ash 1 (aref grid i rj)))))
+    ;; Check square
+    (loop for si of-type fixnum upfrom (* 3 (floor i 3))
+	  repeat 3
+	  do (loop for sj of-type fixnum upfrom (* 3 (floor j 3))
+		   repeat 3
+		   do (setf invalid (logior invalid (ash 1 (aref grid si sj))))))
+    invalid))
+
+(defun solve-sudoku (grid &optional (start-index 0))
+  "Solves the Sudoku puzzle represented by GRID, returning the solved grid on success or NIL on error (optionally starting from START-INDEX)"
+  (let ((index (find-open-cell grid start-index)))
+    (cond ((not index) grid) ; All cells filled in; done!
+	  (t
+	   ;; Found an empty cell; try all valid digits
+	   (multiple-value-bind (i j) (from-index index)
+	     (let ((invalid (compute-invalid grid i j)))
+	       (loop for d from 1 upto 9
+		     unless (logbitp d invalid)
+		       do ;; Check for solution
+			  (setf (aref grid i j) d)
+			  (let ((result (solve-sudoku grid (+ 1 (* 9 i) j))))
+			    (when result
+			      ;; Found a solution; return early
+			      (return-from solve-sudoku result)))
+		     finally
+			;; Revert on failure
+			(setf (aref grid i j) 0)))
+	     nil)))))
+
+(defun solution-code (grid)
+  "Returns a 3-digit number using the first three digits in the top line of the grid"
+  (+ (* 100 (aref grid 0 0))
+     (* 10 (aref grid 0 1))
+     (aref grid 0 2)))
+  
+(defun sudoku (&rest indices)
+  (let ((raw-lines (uiop:read-file-lines "p096_sudoku.txt")))
+    (flet ((go-to-next-grid (list)
+	     (nthcdr 10 list)))
+      (loop with sum = 0
+	    for (title-line . grid-lines) on raw-lines by #'go-to-next-grid
+	    for index upfrom 1
+	    do (when (or (not indices)
+			 (member index indices))
+		 (let* ((grid (parse-grid grid-lines))
+			(solution (solve-sudoku grid)))
+		   (incf sum (solution-code solution))))
+	    finally (return sum)))))