From 5aaf4ebca5374dd7b9606cba7fa26ea7d2369928 Mon Sep 17 00:00:00 2001 From: Matteo Landi Date: Tue, 30 Jan 2024 09:18:42 +0100 Subject: [PATCH] Refactor 2023/20 - Use DEFINE-SOLUTION / DEFINE-TEST - Use CL's signals to avoid some copy-pasta --- src/2023/day20.lisp | 138 ++++++++++++++++++++---------------- vendor/make-quickutils.lisp | 9 ++- vendor/quickutils.lisp | 35 ++++++--- 3 files changed, 112 insertions(+), 70 deletions(-) diff --git a/src/2023/day20.lisp b/src/2023/day20.lisp index 4cac93b..9959775 100644 --- 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 index 069b7c4..d967753 100644 --- 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 index 892b276..0fe1aa5 100644 --- 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 ;;;;