From 90602579fb543a15b689de5b6bcc2ad41ad47c04 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Fri, 12 Jan 2024 03:16:15 +0100
Subject: refactoring

---
 AoC2023/day21/solver.lisp | 110 ++++++++++++++++++++--------------------------
 1 file changed, 47 insertions(+), 63 deletions(-)

(limited to 'AoC2023')

diff --git a/AoC2023/day21/solver.lisp b/AoC2023/day21/solver.lisp
index a120be0..4253569 100644
--- a/AoC2023/day21/solver.lisp
+++ b/AoC2023/day21/solver.lisp
@@ -1,6 +1,6 @@
 (ql:quickload '(fiveam))
 (defpackage :day21
-  (:use :cl :fiveam))
+  (:use :cl :fiveam :alexandria))
 (in-package :day21)
 ;;22:55
 ;;23:32
@@ -13,51 +13,20 @@
         (when (eq (aref field row col) #\S)
           (return-from find-start (list row col)))))))
 
-(defun solver1 (lines step-count)
-  (let* ((field (make-array (list (length lines) (length (car lines)))
-                            :initial-contents lines))
-         pending
-         (end-positions (make-hash-table :test #'equal))
-         (visited (make-hash-table :test #'equal))
-         (start (find-start field)))
-    (destructuring-bind (rows cols)
-        (array-dimensions field)
+(defun read-field (filename)
+  (let* ((lines (uiop:read-file-lines filename)))
+    (make-array (list (length lines) (length (car lines)))
+                :initial-contents lines)))
 
-      (push (cons step-count start) pending)
-      (setf (gethash start visited) step-count)
-
-      (loop while pending
-            for (steps-left row col) = (pop pending)
-            ;; an even number of steps left means it is possible
-            ;; to go and return to the place in the steps available
-            ;; Thus count to the solution.
-            when (evenp steps-left)
-              do (setf (gethash (list row col) end-positions) t)
-            unless (zerop steps-left)
-              do (loop
-                   for (dr dc) in '((-1 0) (0 -1) (1 0) (0 1))
-                   for nr = (+ row dr)
-                   for nc = (+ col dc)
-                   for new-pos = (list nr nc)
-                   when (and (< (gethash new-pos visited -1) (1- steps-left))
-                             (< -1 nr rows)
-                             (< -1 nc cols)
-                             (not (eq #\# (aref field nr nc))))
-                     do (setf (gethash new-pos visited) (1- steps-left))
-                        (push (cons (1- steps-left) new-pos) pending))))
-    (hash-table-count end-positions)))
-
-(test solutions
-  (is (= 16 (solver1 (uiop:read-file-lines "eg-in") 6)))
-  (is (= 3574 (solver1 (uiop:read-file-lines "input") 64))))
-
-(defun solver2 (lines step-count)
-  (let* ((field (make-array (list (length lines) (length (car lines)))
-                            :initial-contents lines))
-         pending
-         (end-positions (make-hash-table :test #'equal))
+(defun solver (field boundedp &rest step-counts)
+  (let* (pending
          (visited (make-hash-table :test #'equal))
-         (start (find-start field)))
+         (start (find-start field))
+         (step-count (car (last step-counts)))
+         (end-positions (mapcar (lambda (s)
+                                  (cons (- step-count s)
+                                        (make-hash-table :test #'equal)))
+                                step-counts)))
     (destructuring-bind (rows cols)
         (array-dimensions field)
 
@@ -69,8 +38,13 @@
             ;; an even number of steps left means it is possible
             ;; to go and return to the place in the steps available
             ;; Thus count to the solution.
-            when (evenp steps-left)
-              do (setf (gethash (list row col) end-positions) t)
+            do
+               (dolist (ep end-positions)
+                 (destructuring-bind (check-point . tracker) ep
+                   (let ((mark-left (- steps-left check-point)))
+                     (when (and (not (minusp mark-left))
+                                (evenp mark-left))
+                       (setf (gethash (list row col) tracker) t)))))
             unless (zerop steps-left)
               do (loop
                    for (dr dc) in '((-1 0) (0 -1) (1 0) (0 1))
@@ -78,22 +52,16 @@
                    for nc = (+ col dc)
                    for new-pos = (list nr nc)
                    when (and (< (gethash new-pos visited -1) (1- steps-left))
+                             (if boundedp
+                                 (and
+                                  (< -1 nr rows)
+                                  (< -1 nc cols))
+                                 t)
                              (not (eq #\# (aref field (mod nr rows) (mod nc cols)))))
                      do (setf (gethash new-pos visited) (1- steps-left))
                         (push (cons (1- steps-left) new-pos) pending))))
-    (hash-table-count end-positions)))
+    (mapcar (compose #'hash-table-count #'cdr) end-positions)))
 
-(solver2 (uiop:read-file-lines "eg-in") 6)
-(solver2 (uiop:read-file-lines "eg-in") 10)
-(solver2 (uiop:read-file-lines "eg-in") 50)
-(solver2 (uiop:read-file-lines "eg-in") 100)
-;; (time (solver2 (uiop:read-file-lines "eg-in") 500))
-
-(defun solve-part2 ()
-  (let ((x 202300))
-    (multiple-value-bind (a b c)
-        (solve-quadratic 3719 33190 91987)
-      (+ (* a x x) (* b x) c))))
 
 (defun solve-quadratic (r-one r-two r-three)
   ;; The covered area grows proportional to the square of steps taken.
@@ -114,8 +82,24 @@
           (/ (- (* 4 r-two) (* 3 r-one) r-three) 2)
           r-one))
 
-(test sols
-  (loop for steps in (list 65 (+ 65 131) (+ 65 (* 131 2)))
-        for result in '(3719 33190 91987)
-        do (is (= result (solver2 (uiop:read-file-lines "input") steps))))
-  (is (= 600090522932119 (solve-part2))))
+(defun solve-part2 (places)
+  (let ((x 202300))
+    (multiple-value-bind (a b c)
+        (apply #'solve-quadratic places)
+      (+ (* a x x) (* b x) c))))
+
+(test solutions
+  (is (= 16 (car (solver (read-field "eg-in") t 6))))
+  (is (= 3574 (car (solver (read-field "input") t 64))))
+  (mapc (lambda (solution calculated)
+          (is (= solution calculated)))
+        '(16 50 1594 6536 26538 59895)
+        (solver (read-field "eg-in") nil 6 10 50 100 200 300))
+
+  (let ((results '(3719 33190 91987))
+        (places (solver (read-field "input") nil 65 (+ 65 131) (+ 65 (* 131 2)))))
+    (mapc (lambda (solution calculated)
+            (is (= solution calculated)))
+          results
+          places)
+    (is (= 600090522932119 (solve-part2 results)))))
-- 
cgit v1.2.3