From 3493b17da08896787c475b903763293f4b4e6f89 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Fri, 29 Dec 2023 18:17:26 +0100
Subject: [AoC2023] day20 lisp part1

---
 AoC2023/day20/eg-i1       |  5 +++
 AoC2023/day20/eg-i2       |  5 +++
 AoC2023/day20/input       | 58 ++++++++++++++++++++++++++++++
 AoC2023/day20/solver.lisp | 91 +++++++++++++++++++++++++++++++++++++++++++++++
 4 files changed, 159 insertions(+)
 create mode 100644 AoC2023/day20/eg-i1
 create mode 100644 AoC2023/day20/eg-i2
 create mode 100644 AoC2023/day20/input
 create mode 100644 AoC2023/day20/solver.lisp

(limited to 'AoC2023')

diff --git a/AoC2023/day20/eg-i1 b/AoC2023/day20/eg-i1
new file mode 100644
index 0000000..2dc1bab
--- /dev/null
+++ b/AoC2023/day20/eg-i1
@@ -0,0 +1,5 @@
+broadcaster -> a, b, c
+%a -> b
+%b -> c
+%c -> inv
+&inv -> a
diff --git a/AoC2023/day20/eg-i2 b/AoC2023/day20/eg-i2
new file mode 100644
index 0000000..2738ceb
--- /dev/null
+++ b/AoC2023/day20/eg-i2
@@ -0,0 +1,5 @@
+broadcaster -> a
+%a -> inv, con
+&inv -> b
+%b -> con
+&con -> output
diff --git a/AoC2023/day20/input b/AoC2023/day20/input
new file mode 100644
index 0000000..410063f
--- /dev/null
+++ b/AoC2023/day20/input
@@ -0,0 +1,58 @@
+%fg -> nt, gt
+&zp -> rx
+%fh -> nt, xz
+%pj -> zj, zq
+%jc -> nt, nk
+%mr -> vv, pz
+%cl -> fp, zq
+%xb -> bl, vv
+%nc -> zq
+%mg -> vn
+%zj -> cf
+&sb -> zp
+%ht -> pp
+%gt -> jc
+%rq -> ft
+&nt -> rq, fg, ft, nd, gt, xz
+%ps -> xm
+%fs -> ff
+%nb -> dv
+%qd -> xb
+%kg -> mr, vv
+%dv -> vv, hr
+%rm -> zq, fs
+%nk -> rq, nt
+%hr -> dm, vv
+%xm -> vn, ht
+%pp -> mq
+%br -> vn, jz
+%gr -> ln
+%bh -> qd, vv
+%cf -> gr, zq
+&vv -> dm, bl, sb, nb, qd, bh
+%zc -> zv
+%zv -> dc, vn
+%jz -> qs
+&nd -> zp
+%rd -> nc, zq
+&ds -> zp
+%mq -> vn, zc
+%bl -> bb
+%qn -> nt
+%pz -> vv
+%qs -> vn, ps
+%lm -> nt, qn
+%xz -> dr
+%bb -> nb, vv
+%dm -> kg
+%ft -> fh
+&vn -> br, jz, ht, ps, zc, pp, ds
+%xd -> nt, lm
+&hf -> zp
+broadcaster -> pj, fg, bh, br
+%fp -> rd, zq
+&zq -> fs, gr, ff, hf, ln, zj, pj
+%ff -> cl
+%dr -> xd, nt
+%ln -> rm
+%dc -> mg, vn
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")))))
-- 
cgit v1.2.3