Refactor 2023/08

src/2023/day08.lisp

@@ -1,35 +1,33 @@
 (defpackage :aoc/2023/08 #.cl-user::*aoc-use*)
 (in-package :aoc/2023/08)
 
-(defun parse-input (&optional (strings (uiop:read-file-lines #P"src/2023/day08.txt")))
-  (destructuring-bind (instructions ignore . nodes) strings
-    (flet ((node (s)
-             (mapcar #'as-keyword (cl-ppcre:all-matches-as-strings "\\w+" s))))
-      (cons (coerce instructions 'list)
-            (mapcar #'node nodes)))))
+(defun parse-input (&optional (strings (aoc::read-problem-input 2023 08)))
+  (destructuring-bind (instructions _ . network) strings
+    (declare (ignore _))
+    (flet ((node (s) (mapcar #'as-keyword (cl-ppcre:all-matches-as-strings "\\w+" s))))
+      (cons (ncycle (coerce instructions 'list))
+            (mapcar #'node network)))))
 
-; (loop with (inst . nodes) = (parse-input)
-;       for step from 0
-;       for node = (assoc :aaa nodes) then (assoc next nodes)
-;       for in in (ncycle inst) for next = (if (eq in #\L) (second node) (third node))
-;       when (eq (car node) :zzz) return step)
-; => 21409
 
-(defun node-name-ends-with-char? (ch node)
-  (char= (char (reverse (mkstr (first node))) 0) ch))
-(node-name-ends-with-char? #\A '(:aaz))
+(defun count-steps (start end? &optional (input (parse-input)))
+  (destructuring-bind (instructions . network) input
+    (recursively ((curr start)
+                  (instructions instructions)
+                  (steps 0))
+      (if (funcall end? curr)
+        steps
+        (destructuring-bind (left right) (assoc-value network curr)
+          (ecase (car instructions)
+            (#\L (recur left (cdr instructions) (1+ steps)))
+            (#\R (recur right (cdr instructions) (1+ steps)))))))))
 
-(defun find-part2 (start &optional (strings (uiop:read-file-lines #P"src/2023/day08.txt")))
-  (loop with (inst . nodes) = (parse-input)
-        for step from 0
-        for node = (assoc start nodes) then (assoc next nodes)
-        for in in (ncycle inst) for next = (if (eq in #\L) (second node) (third node))
-        when (node-name-ends-with-char? #\Z node) return step
-        never (not node)))
 
-; (apply
-;   #'lcm
-;   (looping
-;     (dolist (start (remove-if-not [node-name-ends-with-char? #\A _] (cdr (parse-input))))
-;       (collect! (find-part2 (car start))))))
-; => 21165830176709
+(define-solution (2023 08) (input parse-input)
+  (values (count-steps :aaa [eq _ :zzz] input)
+          (destructuring-bind (instructions . network) input
+            (bnd* ((start-nodes (keep-if [string-ends-with-p "A" (mkstr _)]
+                                         (alist-keys network) ))
+                   (end? [string-ends-with-p "Z" (mkstr _)]))
+              (apply #'lcm (mapcar [count-steps _ end? input] start-nodes))))))
+
+(define-test (2023 08) (21409 21165830176709))

vendor/make-quickutils.lisp

@@ -50,6 +50,7 @@
                :mkstr
                :mulf
                :ncycle
+               :recursively
                :repeat
                :string-ends-with-p
                :string-starts-with-p

vendor/quickutils.lisp

@@ -2,7 +2,7 @@
 ;;;; See http://quickutil.org for details.
 
 ;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:KEEP-IF :KEEP-IF-NOT :AAND :AIF :ALIST-KEYS :ALIST-VALUES :ASSOC-VALUE :AWHEN :BND* :BND1 :COPY-ARRAY :COPY-HASH-TABLE :DIGITS :DIVF :DOALIST :DOHASH :DOLISTS :DORANGE :DORANGEI :DOSEQ :DOSEQS :DOSUBLISTS :ENUMERATE :FLATTEN :HASH-TABLE-ALIST :HASH-TABLE-KEY-EXISTS-P :HASH-TABLE-KEYS :HASH-TABLE-VALUES :IF-LET :IF-NOT :IOTA :LOOPING :MAKE-KEYWORD :MKSTR :MULF :NCYCLE :REMOVEF :REPEAT :STRING-ENDS-WITH-P :STRING-STARTS-WITH-P :SUBDIVIDE :SUBSEQ- :SYMB :VOID :WHEN-LET :WHEN-NOT :WHILE :WITH-GENSYMS :SHUFFLE :RANDOM-ELT :XOR) :ensure-package T :package "AOC.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:KEEP-IF :KEEP-IF-NOT :AAND :AIF :ALIST-KEYS :ALIST-VALUES :ASSOC-VALUE :AWHEN :BND* :BND1 :COPY-ARRAY :COPY-HASH-TABLE :DIGITS :DIVF :DOALIST :DOHASH :DOLISTS :DORANGE :DORANGEI :DOSEQ :DOSEQS :DOSUBLISTS :ENUMERATE :FLATTEN :HASH-TABLE-ALIST :HASH-TABLE-KEY-EXISTS-P :HASH-TABLE-KEYS :HASH-TABLE-VALUES :IF-LET :IF-NOT :IOTA :LOOPING :MAKE-KEYWORD :MKSTR :MULF :NCYCLE :RECURSIVELY :REMOVEF :REPEAT :STRING-ENDS-WITH-P :STRING-STARTS-WITH-P :SUBDIVIDE :SUBSEQ- :SYMB :VOID :WHEN-LET :WHEN-NOT :WHILE :WITH-GENSYMS :SHUFFLE :RANDOM-ELT :XOR) :ensure-package T :package "AOC.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "AOC.QUICKUTILS")
@@ -26,8 +26,9 @@
                                          :HASH-TABLE-KEYS :MAPHASH-VALUES
                                          :HASH-TABLE-VALUES :IF-LET :IF-NOT
                                          :IOTA :MKSTR :SYMB :LOOPING
-                                         :MAKE-KEYWORD :MULF :NCYCLE :REMOVEF
-                                         :REPEAT :STRING-ENDS-WITH-P
+                                         :MAKE-KEYWORD :MULF :NCYCLE
+                                         :RECURSIVELY :REMOVEF :REPEAT
+                                         :STRING-ENDS-WITH-P
                                          :STRING-STARTS-WITH-P :SUBDIVIDE
                                          :SUBSEQ- :VOID :WHEN-LET :WHEN-NOT
                                          :WHILE :SAFE-ENDP :CIRCULAR-LIST
@@ -747,6 +748,15 @@ Examples:
     (nconc list list))
 
 
+  (defmacro recursively (bindings &body body)
+    (let ((names (mapcar #'(lambda (b) (if (atom b) b (first b))) bindings))
+          (values (mapcar #'(lambda (b) (if (atom b) nil (second b))) bindings)))
+      (let1 recur (intern "RECUR")
+        `(labels ((,recur (,@names)
+                    ,@body))
+           (,recur ,@values)))))
+
+
   (declaim (inline remove/swapped-arguments))
   (defun remove/swapped-arguments (sequence item &rest keyword-arguments)
     (apply #'remove item sequence keyword-arguments))
@@ -1051,9 +1061,9 @@ value."
             doalist dohash dolists dorange dorangei doseq doseqs dosublists
             enumerate flatten hash-table-alist hash-table-key-exists-p
             hash-table-keys hash-table-values if-let if-not iota looping
-            make-keyword mkstr mulf ncycle removef repeat string-ends-with-p
-            string-starts-with-p subdivide subseq- symb void when-let when-let*
-            when-not while with-gensyms with-unique-names shuffle random-elt
-            xor)))
+            make-keyword mkstr mulf ncycle recursively removef repeat
+            string-ends-with-p string-starts-with-p subdivide subseq- symb void
+            when-let when-let* when-not while with-gensyms with-unique-names
+            shuffle random-elt xor)))
 
 ;;;; END OF quickutils.lisp ;;;;