1 files changed, 19 insertions, 51 deletions
diff --git a/AoC2023/day03/solver.lisp b/AoC2023/day03/solver.lisp
index 6f9c799..b326a88 100644
--- a/AoC2023/day03/solver.lisp
+++ b/AoC2023/day03/solver.lisp
@@ -18,67 +18,35 @@
       (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 in-line-numbers (line symbol-pos)
+  (loop for (num-start num-end) on (cl-ppcre:all-matches "\\d+" line) by #'cddr
+        when (<= (1- num-start) symbol-pos num-end)
+          collect (parse-integer (subseq line num-start num-end))))
 
+(defun adjacent-numbers (rows row limits symbol-pos)
+  (loop for y in (list (1- row) row (1+ row))
+        when (funcall limits (cons y symbol-pos))
+          nconc (in-line-numbers (aref rows y) symbol-pos)))
 
-(defun solver1 (lines)
+(defun solver (lines symbol-regex reducer)
   (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))
+                           (1- (length (car lines))))))
     (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))
-
+          sum (loop for (start _end) on (cl-ppcre:all-matches symbol-regex (aref rows row)) by #'cddr
+                    sum (funcall reducer (adjacent-numbers rows row limits start))))))
 
-(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 solver1 (lines)
+  (solver lines "[^.\\d]" (lambda (numbers) (apply #'+ numbers))))
 
 
 (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))
+  (solver lines "\\*"
+          (lambda (ratios)
+            (if (= 2 (length ratios))
+                (* (car ratios) (cadr ratios))
+                0))))
 
 (fiveam:test solutions
   (fiveam:is (= 4361 (solver1 (uiop:split-string eg-input :separator '(#\Newline)))))