day-20.lisp (4986B)
1 (defpackage #:aoc/day-20 2 (:use #:cl #:aoc/utils) 3 (:export #:day-20)) 4 (in-package #:aoc/day-20) 5 6 (defclass module () 7 ((label 8 :initarg :label 9 :reader module-label) 10 (targets 11 :initarg :targets 12 :accessor module-targets) 13 (connected 14 :initform nil 15 :accessor module-connected))) 16 17 (defmethod print-object ((module module) stream) 18 (print-unreadable-object (module stream :type t) 19 (format stream "~A" (module-label module)))) 20 21 (defclass flip-flop (module) 22 ((state 23 :initform nil))) 24 25 (defmethod print-object ((module flip-flop) stream) 26 (print-unreadable-object (module stream :type t) 27 (with-slots (state) 28 module 29 (format stream "~A (~A)" (module-label module) 30 (if state "on" "off"))))) 31 32 (defclass conjunction (module) 33 ((states 34 :initform (make-hash-table)))) 35 36 (defclass noop-module (module) 37 ()) 38 39 (defmethod pulse ((module module) sender type) 40 (with-slots (targets) 41 module 42 (loop for target in targets 43 collect (list module target type)))) 44 45 (defmethod pulse ((module flip-flop) sender type) 46 (with-slots (state) 47 module 48 (when (eq type :low) 49 (setf state (not state)) 50 (call-next-method module sender (if state :high :low))))) 51 52 (defmethod pulse ((module conjunction) sender type) 53 (with-slots (states connected) 54 module 55 (setf (gethash sender states) type) 56 (call-next-method module sender (if (loop for from in connected 57 for mem = (gethash from states) 58 always (eq mem :high)) 59 :low 60 :high)))) 61 62 (defmethod pulse ((module noop-module) sender type)) 63 64 (defun parse-line (line) 65 (let* ((pos-source-end (position #\Space line)) 66 (source-type (case (aref line 0) 67 (#\% 'flip-flop) 68 (#\& 'conjunction) 69 (t 'module))) 70 (source-label (subseq line 71 (if (eq source-type 'module) 0 1) 72 pos-source-end)) 73 (target-labels (loop for pos from (+ pos-source-end 4) below (length line) 74 for end = (or (position #\, line :start pos) 75 (length line)) 76 collect (subseq line pos end) 77 do (setf pos (1+ end))))) 78 (make-instance source-type :label source-label :targets target-labels))) 79 80 (defun parse-input (input) 81 (let ((modules (make-hash-table :test 'equal))) 82 (loop for line = (read-line input nil) 83 while line 84 for module = (parse-line line) 85 do (setf (gethash (module-label module) modules) module)) 86 (loop for module being the hash-value of modules 87 do (setf (module-targets module) 88 (loop for target-label in (module-targets module) 89 for target-module = (or (gethash target-label modules) 90 (setf (gethash target-label modules) 91 (make-instance 'noop-module 92 :label target-label))) 93 do (push module (module-connected target-module)) 94 collect target-module))) 95 modules)) 96 97 (defun day-20 (input) 98 (loop with modules = (parse-input input) 99 with broadcast = (gethash "broadcaster" modules) 100 with rx-source-modules = (when-let (rx (gethash "rx" modules)) 101 (module-connected (first (module-connected rx)))) 102 with rx-source-intervals = (make-hash-table) 103 with task-1 = 0 104 with task-2 = 0 105 with low-count = 0 106 with high-count = 0 107 for i from 1 108 do (loop with next = (list (list nil broadcast :low)) 109 while next 110 for n = (loop for (from to type) in next 111 do (ecase type 112 (:low (incf low-count)) 113 (:high (progn 114 (when (and (member from rx-source-modules) 115 (not (gethash from rx-source-intervals))) 116 (setf (gethash from rx-source-intervals) i)) 117 (incf high-count)))) 118 nconc (pulse to from type)) 119 do (setf next n)) 120 when (= i 1000) 121 do (setf task-1 (* low-count high-count)) 122 when (= (hash-table-count rx-source-intervals) (length rx-source-modules)) 123 do (setf task-2 (apply #'lcm (hash-table-values rx-source-intervals))) 124 when (if rx-source-modules (> task-2 0) (> task-1 0)) 125 do (return (values task-1 task-2))))