solution part2

1 files changed, 48 insertions, 22 deletions

diff --git a/AoC2023/day08/solver.lisp b/AoC2023/day08/solver.lisp
index b552ef5..0681e15 100644
--- a/AoC2023/day08/solver.lisp
+++ b/AoC2023/day08/solver.lisp
@@ -1,6 +1,5 @@
-(ql:quickload '(fiveam str))
-                                        ;12:13
-                                        ;
+(ql:quickload '(fiveam str arrows))
+
 (defparameter eg-input "LLR
 
 AAA = (BBB, BBB)
@@ -8,34 +7,61 @@ BBB = (AAA, ZZZ)
 ZZZ = (ZZZ, ZZZ)")
 
 (defun parse-input (lines)
-  (let ((graph (make-hash-table)))
+  (let ((graph (make-hash-table :test #'equal)))
     (destructuring-bind (instructions blank . nodes) lines
       (declare (ignorable blank))
       (dolist (line nodes)
-        (with-input-from-string (in (str:replace-all "=|," "" line :regex t))
-          (setf
-           (gethash (read in) graph)
-           (read in))))
+        (destructuring-bind (node . leaves)
+            (remove-if #'str:emptyp
+                       (cl-ppcre:split "[=,() ]" line))
+          (setf (gethash node graph) leaves)))
       (values instructions graph))))
 
-(defun traverse (instructions graph location steps)
-  (if (eq location 'ZZZ)
-      (values steps location)
-      (let ((new-steps (loop
-                         for direction across instructions
-                         do
-                            (setf location
-                                  (ecase direction
-                                    (#\L (first (gethash location graph)))
-                                    (#\R (second (gethash location graph)))))
-                         count direction until (eq location 'ZZZ))))
-        (traverse instructions graph location (+ steps new-steps)))))
+(defun traverse (instructions graph location terminatep)
+  (labels ((rec (steps)
+             (if (funcall terminatep location)
+                 (values steps location)
+                 (rec (+ steps (steps-needed)))))
+           (steps-needed ()
+             (loop
+               for direction across instructions
+               do (arrows:-<>
+                   (ecase direction
+                     (#\L #'first)
+                     (#\R #'second))
+                   (funcall <> (gethash location graph))
+                   (setf location <>))
+               count direction until (funcall terminatep location))))
+    (rec 0)))
 
 (defun solver1 (lines)
   (multiple-value-bind (instructions graph)
       (parse-input lines)
-    (traverse instructions graph 'AAA 0)))
+    (traverse instructions graph "AAA" (lambda (p) (equal "ZZZ" p)))))
+
+(defparameter eg-input2 "LR
+
+11A = (11B, XXX)
+11B = (XXX, 11Z)
+11Z = (11B, XXX)
+22A = (22B, XXX)
+22B = (22C, 22C)
+22C = (22Z, 22Z)
+22Z = (22B, 22B)
+XXX = (XXX, XXX)")
+
+(defun solver2 (lines)
+  (multiple-value-bind (instructions graph)
+      (parse-input lines)
+    (arrows:->>
+     (remove-if-not (lambda (s) (str:ends-with-p "A" s))
+                    (alexandria:hash-table-keys graph))
+     (mapcar (lambda (start)
+               (traverse instructions graph start (lambda (p) (str:ends-with-p "Z" p)))))
+     (apply #'lcm))))
 
 (fiveam:test solutions
   (fiveam:is (= 6 (solver1 (uiop:split-string eg-input :separator '(#\Newline)))))
-  (fiveam:is (= 19199 (solver1 (uiop:read-file-lines "input")))))
+  (fiveam:is (= 6 (solver2 (uiop:split-string eg-input2 :separator '(#\Newline)))))
+  (fiveam:is (= 19199 (solver1 (uiop:read-file-lines "input"))))
+  (fiveam:is (= 13663968099527(solver2 (uiop:read-file-lines "input")))))