[AoC2023] day20 lisp part1

1 files changed, 91 insertions, 0 deletions

diff --git a/AoC2023/day20/solver.lisp b/AoC2023/day20/solver.lisp
new file mode 100644
index 0000000..87597cf
--- /dev/null
+++ b/AoC2023/day20/solver.lisp
@@ -0,0 +1,91 @@
+(ql:quickload '(fiveam str arrows))
+(use-package '(alexandria fiveam))
+
+(defstruct module
+  type state outputs)
+
+(defun parse-input (lines)
+  (let ((board (make-hash-table)))
+    (dolist (instruction lines board)
+      (destructuring-bind (module outputs) (str:split " -> " instruction)
+        (let ((outputs (mapcar #'read-from-string (str:split ", " outputs)))
+              (name (if (string-equal "broadcaster" module) 'broadcaster (read-from-string (subseq module 1))))
+              (type (ecase (elt module 0)
+                      (#\b 'broadcaster)
+                      (#\& 'conjunction)
+                      (#\% 'flip-flop))))
+          (setf (gethash name board) (make-module :type type
+                                                  :state (if (eq type 'conjunction) (make-hash-table) 'off)
+                                                  :outputs outputs)))))))
+
+(defun prepare-board (board)
+  (maphash (lambda (name value)
+             (with-slots (type state outputs) value
+               (dolist (out outputs)
+                 (when (arrows:some->
+                        (gethash out board)
+                        (slot-value 'type)
+                        (eq 'conjunction))
+                   (setf (gethash name (slot-value (gethash out board) 'state)) 'low)))))
+           board)
+  board)
+
+(defun toggle (state)
+  (ecase state
+    (off 'on)
+    (on 'off)))
+
+(defun all-high-p (state)
+  (every (lambda (v) (eq 'high v)) (hash-table-values state)))
+
+(defun propagate (board signals)
+  (mapcan
+   (lambda (in)
+     (destructuring-bind (from to signal) in
+       (when (gethash to board)
+         (with-slots (type state outputs) (gethash to board)
+           (when-let
+               ((msg
+                 (ecase type
+                   (broadcaster signal)
+                   (flip-flop (when (eq signal 'low)
+                                (ecase (setf state (toggle state))
+                                  (on 'high)
+                                  (off 'low))))
+                   (conjunction
+                    (setf (gethash from state) signal)
+                    (if (all-high-p state) 'low 'high)))))
+             (mapcar (lambda (o) (list to o msg)) outputs))))))
+   signals))
+
+(test parts
+  (let ((board (prepare-board (parse-input (uiop:read-file-lines "eg-i1")))))
+    (is (equal
+         '((BROADCASTER A LOW) (BROADCASTER B LOW) (BROADCASTER C LOW))
+         (propagate board '((button broadcaster low)))))
+    (is (equal
+         '((C INV HIGH))
+         (propagate board '((broadcaster C low)))))
+    (is (equal
+         '((INV A LOW))
+         (propagate board '((c inv high)))))
+    (is (null (propagate board '((c blank low)))))))
+
+(defun solver1 (lines)
+  (let ((board (prepare-board (parse-input lines))))
+    (labels ((rec (signals n-high n-low)
+               (if (null signals)
+                   (list n-high n-low)
+                   (rec (propagate board signals)
+                        (+ n-high (count 'high signals :key #'caddr))
+                        (+ n-low (count 'low signals :key #'caddr))))))
+      (loop repeat 1000
+            for (high low) = (rec '((button broadcaster low)) 0 0)
+            sum high into n-high
+            sum low into n-low
+            finally (return  (* n-high n-low))))))
+
+(test solutions
+  (is (= 32000000 (solver1 (uiop:read-file-lines "eg-i1"))))
+  (is (= 11687500 (solver1 (uiop:read-file-lines "eg-i2"))))
+  (is (= 791120136 (solver1 (uiop:read-file-lines "input")))))