1 files changed, 87 insertions, 0 deletions
diff --git a/AoC2023/day03/solver.lisp b/AoC2023/day03/solver.lisp
new file mode 100644
index 0000000..6f9c799
--- /dev/null
+++ b/AoC2023/day03/solver.lisp
@@ -0,0 +1,87 @@
+(ql:quickload '(fiveam cl-ppcre))
+
+(defparameter eg-input "467..114..
+...*......
+..35..633.
+......#...
+617*......
+.....+.58.
+..592.....
+......755.
+...$.*....
+.664.598..")
+
+
+(defun inbounds (row-max col-max)
+  (lambda (cell)
+    (destructuring-bind (row . col) cell
+      (and (<= 0 row row-max)
+           (<= 0 col col-max)))))
+
+(defun contour (row start end)
+  (list*
+   (cons row (1- start))
+   (cons row end)
+   (loop for i from (1- start) to end
+         collect (cons (1- row) i)
+         collect (cons (1+ row) i))))
+
+(defun is-relevant (limits rows)
+  (lambda(row start end)
+    (some
+     (lambda (cell)
+       (and (funcall limits cell)
+            (destructuring-bind (row . col) cell
+              (let ((char (aref (aref rows row) col)))
+                (not (or (digit-char-p char)
+                         (eq #\. char)))))))
+     (contour row start end))))
+
+
+(defun solver1 (lines)
+  (let* ((rows (make-array (length lines) :initial-contents lines
+                                          :adjustable t))
+         (limits (inbounds (1- (length lines))
+                           (1- (length (car lines)))))
+         (keep (is-relevant limits rows))
+         (sum 0))
+    (loop for row below (length lines)
+          for content = (aref rows row) do
+            (cl-ppcre:do-scans (start end _rs _re "\\d+" content)
+              (when (funcall keep row start end)
+                ;; (format t "~a ~a ~a~%" start end (subseq content start end))
+                (incf sum (parse-integer (subseq content start end))))))
+    sum))
+
+
+(defun adjacent-numbers (line gear-start)
+  (loop for (num-start num-end) on (cl-ppcre:all-matches "\\d+" line) by #'cddr
+        when (<= (1- num-start) gear-start num-end)
+          collect (parse-integer (subseq line num-start num-end))))
+
+
+(defun solver2 (lines)
+  (let* ((rows (make-array (length lines) :initial-contents lines
+                                          :adjustable t))
+         (limits (inbounds (1- (length lines))
+                           (1- (length (car lines)))))
+         (sum 0))
+    (loop for row below (length lines)
+          for content = (aref rows row) do
+            (loop for (gear-start end) on (cl-ppcre:all-matches "\\*" content) by #'cddr do
+              (let ((ratios
+                      (append
+                       (when (funcall limits (cons (1- row) gear-start))
+                         (adjacent-numbers (aref rows (1- row)) gear-start))
+                       (adjacent-numbers content gear-start)
+                       (when (funcall limits (cons (1+ row) gear-start))
+                         (adjacent-numbers (aref rows (1+ row)) gear-start)))))
+                (when (= 2 (length ratios))
+                  (incf sum (* (car ratios) (cadr ratios)))))))
+    sum))
+
+(fiveam:test solutions
+  (fiveam:is (= 4361 (solver1 (uiop:split-string eg-input :separator '(#\Newline)))))
+  (fiveam:is (= 467835  (solver2 (uiop:split-string eg-input :separator '(#\Newline)))))
+  (fiveam:is (= 531561 (solver1 (uiop:read-file-lines "input"))))
+  (fiveam:is (= 83279367(solver2 (uiop:read-file-lines "input")))))