Refactor 2023/20

- Use DEFINE-SOLUTION / DEFINE-TEST - Use CL's signals to avoid some copy-pasta
iamFIREcracker · Jan 30, 2024 · 5aaf4eb · 5aaf4eb
1 parent f2e8d4f
commit 5aaf4eb
Show file tree

Hide file tree

Showing 3 changed files with 112 additions and 70 deletions.
diff --git a/src/2023/day20.lisp b/src/2023/day20.lisp
@@ -16,91 +16,107 @@
               :inputs nil
               :state :low
               :outputs (mapcar #'as-keyword outputs))))))
-
 (defun name (m) (getf m :name))
 
-(defun parse-input (&optional (strings (uiop:read-file-lines #P"src/2023/day20.txt")))
+(defun parse-input (&optional (strings (aoc::read-problem-input 2023 20)))
   (bnd* ((modules (cons (button) (mapcar #'parse-module strings))))
     (doseq (m modules)
       (dolist (n (getf m :outputs))
         (bnd* ((o (find n modules :key #'name)))
           (setf (getf (getf o :inputs) (name m)) :low))))
     modules))
-#+#:excluded (parse-input)
 
 (defun low? (i) (eq i :low))
 (defun high? (i) (eq i :high))
 (defun flip (i) (if (low? i) :high :low))
 
-(defun plist-keys (plist) (loop for k in plist by #'cddr collect k))
-(defun plist-values (plist) (loop for v in (cdr plist) by #'cddr collect v))
 
-(defun change-input (m from pulse)
-  (setf (getf (getf m :inputs) from) pulse)
-  (bnd1 (new (%new-state m  pulse))
+(defun change-input (m from pulse-type)
+  (setf (getf (getf m :inputs) from) pulse-type)
+  (bnd1 (new (%new-state m pulse-type))
     (if new (setf (getf m :state) new))
     new))
 
-(defun %new-state (m last-pulse)
+(defun %new-state (m last-pulse-type)
   (case (getf m :type)
-    (% (if (low? last-pulse) (flip (getf m :state))))
+    (% (if (low? last-pulse-type) (flip (getf m :state))))
     (& (if (every #'high? (plist-values (getf m :inputs))) :low :high))
-    (otherwise last-pulse)))
+    (otherwise last-pulse-type)))
+
+(define-condition pulse ()
+  ((type :initarg :type)
+   (from :initarg :from)
+   (to :initarg :to)))
+
+(defun push-button (&optional (modules (parse-input)))
+  (bnd* ((pulses (list :low 0 :high 0))
+         (q (make-queue)))
+    (enqueue '(:low :elves :button) q)
+    (while-not (queue-empty-p q)
+      (destructuring-bind (pulse-type from to) (dequeue q)
+        (signal 'pulse :type pulse-type :from from :to to)
+        (bnd1 (m (find to modules :key #'name))
+          (awhen (change-input m from pulse-type)
+            (dolist (n (getf m :outputs))
+              (incf (getf pulses it))
+              (enqueue (list it (name m) n) q))))))
+    (plist-values pulses)))
 
-; (untrace %new-state)
 
 (defun warm-up (&optional (modules (parse-input)))
   (bnd1 (pulses (list :low 0 :high 0))
-    (labels ((push-button ()
-               (bnd1 (q (list (list :low :elves :button)))
-                 (while q
-                   (setf q
-                         (looping
-                           (doseq ((pulse from to) q)
-                             (bnd* ((m (find to modules :key #'name)))
-                               (awhen (change-input m from pulse)
-                                 (dolist (n (getf m :outputs))
-                                   (incf (getf pulses it))
-                                   ; (pr (name m) it n)
-                                   (collect! (list it (name m) n))))))))))))
-
-      (repeat 1000
-        (push-button)))
-    pulses))
-#+#:excluded (reduce #'* (plist-values (warm-up)))
-; 95113840 nope
-; 86755932 nope
-; 883726240
-
-
-(defun push-until (expected-pulse expected-from expected-to
-                                  &optional (modules (parse-input)))
-  (bnd* ((pushes 0))
-    (labels ((push-button ()
-               (bnd1 (q (list (list :low :elves :button)))
-                 (while q
-                   (setf q
-                         (looping
-                           (doseq ((pulse from to) q)
-                             (when (and (eq expected-pulse pulse)
-                                        (eq expected-from from)
-                                        (eq expected-to to))
-                               (return-from push-until pushes))
-                             (bnd* ((m (find to modules :key #'name)))
-                               (awhen (change-input m from pulse)
-                                 (dolist (n (getf m :outputs))
-                                   (collect! (list it (name m) n))))))))))))
-
+    (repeat 1000
+      (destructuring-bind (low high) (push-button modules)
+        (incf (getf pulses :low) low)
+        (incf (getf pulses :high) high)))
+    (reduce #'* (plist-values pulses))))
+
+
+;; By inspecting my input I realized that:
+;;
+;; - Only one module outputs into :RX (:BB in my case, a conjuction module)
+;; - There are 4 modules who output into :BB (:CT, KP, KS, and :XC, all
+;;   conjuctions)
+;;
+;; :BB is a conjuction module, and will output a low pulse when all its inputs
+;; are :high.
+;;
+;; So what I did was monitoring the network and keep track of the number of
+;; times I need to push the button to get any of the :BB's input to generate
+;; a high pulse.  Assume some periodicity, et voila`!
+(defun turn-on-engine (&optional (strings (aoc::read-problem-input 2023 20)))
+  (apply #'lcm
+         (looping
+           (bnd1 (modules (parse-input strings))
+             (destructuring-bind (to) (find-that-outputs-into :rx modules)
+               (dolist (from (find-that-outputs-into (name to) modules))
+                 (print (name from))
+                 (collect! (push-until :high
+                                       (name from)
+                                       (name to)
+                                       (parse-input strings)))))))))
+
+(defun find-that-outputs-into (name &optional (modules (parse-input)))
+  (keep-if [member name (getf _ :outputs)] modules))
+
+
+(defun push-until (expected-pulse-type expected-from expected-to
+                                       &optional (modules (parse-input)))
+  (bnd1 (pushes 0)
+    (handler-bind ((pulse
+                     (lambda (c)
+                       (with-slots (type from to) c
+                         (when (and (eq expected-pulse-type type)
+                                    (eq expected-from from)
+                                    (eq expected-to to))
+                           (return-from push-until pushes))))))
       (while t
         (incf pushes)
-        (push-button)))))
-#+#:excluded (push-until :low :fr)
-#+#:excluded (push-until :low :ms)
-#+#:excluded (push-until :low :rx)
+        (push-button modules)))))
+
 
+(define-solution (2023 20) (strings)
+  (values (warm-up (parse-input strings))
+          (turn-on-engine strings)))
 
-#+#:excluded (lcm
-               (push-until :high :xc :bb)
-               (push-until :high :ks :bb)
-               (push-until :high :kp :bb)
-               (push-until :high :ct :bb))
+(define-test (2023 20) (883726240 211712400442661))
diff --git a/vendor/make-quickutils.lisp b/vendor/make-quickutils.lisp
@@ -42,15 +42,18 @@
                :hash-table-key-exists-p
                :hash-table-keys
                :hash-table-values
-               :if-not
                :if-let
+               :if-not
                :iota
                :looping
                :make-keyword
                :mkstr
                :mulf
                :ncycle
+               :plist-keys
+               :plist-values
                :recursively
+               :removef
                :repeat
                :string-ends-with-p
                :string-starts-with-p
@@ -61,7 +64,11 @@
                :when-let
                :when-not
                :while
+               :while-not
                :with-gensyms
 
+:shuffle
+:random-elt
+:xor
                )
   :package "AOC.QUICKUTILS")
diff --git a/vendor/quickutils.lisp b/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 :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")
+;;;; (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 :PLIST-KEYS :PLIST-VALUES :RECURSIVELY :REMOVEF :REPEAT :STRING-ENDS-WITH-P :STRING-STARTS-WITH-P :SUBDIVIDE :SUBSEQ- :SYMB :VOID :WHEN-LET :WHEN-NOT :WHILE :WHILE-NOT :WITH-GENSYMS :SHUFFLE :RANDOM-ELT :XOR) :ensure-package T :package "AOC.QUICKUTILS")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (unless (find-package "AOC.QUICKUTILS")
@@ -27,11 +27,12 @@
                                          :HASH-TABLE-VALUES :IF-LET :IF-NOT
                                          :IOTA :MKSTR :SYMB :LOOPING
                                          :MAKE-KEYWORD :MULF :NCYCLE
-                                         :RECURSIVELY :REMOVEF :REPEAT
-                                         :STRING-ENDS-WITH-P
+                                         :PLIST-KEYS :PLIST-VALUES :RECURSIVELY
+                                         :REMOVEF :REPEAT :STRING-ENDS-WITH-P
                                          :STRING-STARTS-WITH-P :SUBDIVIDE
                                          :SUBSEQ- :VOID :WHEN-LET :WHEN-NOT
-                                         :WHILE :SAFE-ENDP :CIRCULAR-LIST
+                                         :WHILE :UNTIL :WHILE-NOT :SAFE-ENDP
+                                         :CIRCULAR-LIST
                                          :PROPER-LIST-LENGTH/LAST-CAR :SHUFFLE
                                          :RANDOM-ELT :XOR))))
 
@@ -748,6 +749,16 @@ Examples:
     (nconc list list))
 
 
+  (defun plist-keys (plist)
+    "Return all the keys of `plist`."
+    (loop for k in plist by #'cddr collect k))
+
+
+  (defun plist-values (plist)
+    "Return all the values of `plist`."
+    (loop for v in (cdr plist) by #'cddr collect v))
+
+
   (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)))
@@ -897,6 +908,14 @@ PROGN."
        ,@body))
 
 
+  (defmacro until (expression &body body)
+    "Executes `body` until `expression` is true."
+    `(do ()
+         (,expression)
+       ,@body))
+
+  (abbr while-not until)
+
   (declaim (inline safe-endp))
   (defun safe-endp (x)
     (declare (optimize safety))
@@ -1060,9 +1079,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 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)))
+            make-keyword mkstr mulf ncycle plist-keys plist-values recursively
+            removef repeat string-ends-with-p string-starts-with-p subdivide
+            subseq- symb void when-let when-let* when-not while while-not
+            with-gensyms with-unique-names shuffle random-elt xor)))
 
 ;;;; END OF quickutils.lisp ;;;;