aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2023/day20/solver.lisp
blob: 21b0bed9e797d6e3eb128b8490e13bf19a1b44c5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
(ql:quickload '(fiveam str arrows))
(defpackage :day20
  (:use :cl :fiveam :alexandria))
(in-package :day20)

(defstruct (module (:constructor mk-module
                       (type outputs
                        &aux (state (if (eq type 'conjunction)
                                        (make-hash-table) 'off)))))
  type state outputs)

(defun prepare-board (board)
  "Records into every conjunction which are its inputs."
  (maphash (lambda (name value)
             (with-slots (type state outputs) value
               (dolist (out outputs)
                 (when (arrows:some->
                        (gethash out board)
                        (module-type)
                        (eq 'conjunction))
                   (setf (gethash name (module-state (gethash out board))) 'low)))))
           board))

(defun parse-input (lines)
  (let ((board (make-hash-table)))
    (dolist (instruction lines)
      (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) (mk-module type outputs)))))
    (prepare-board 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 (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 (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))))))

(defun common-cycle (cycles)
  (apply #'lcm (mapcar #'cdr cycles)))

(defun solver2 ()
  (let* ((board (parse-input (uiop:read-file-lines "input")))
         (start '((button broadcaster low)))
         ;; feed is a single conjunction that gives to rx by inspecting input
         ;; feed has 4 inputs, it needs them all to be on high before it outputs
         ;; a low for rx
         ;; The main assumption is that each one of those inputs will send a high
         ;; periodically, and all will be on high on the least common multiple of
         ;; their cycle.
         (feed (loop for name being the hash-key of board
                       using (hash-value module)
                     when (member 'rx (module-outputs module))
                       return name))
         cycles)

    (maphash (lambda (name module)
               (when (member feed (module-outputs module))
                 (push (cons name nil) cycles)))
             board)

    (loop named outer
          for signals = (propagate board start) then (propagate board (or signals start))
          count (null signals) into presses
          ;; until (< 4000 presses)
          do
             (loop for (from to pulse) in signals do
               (when (and (eq to feed) (eq pulse 'high))
                 (setf (cdr (assoc from cycles)) (1+ presses)))
               (when (every (compose #'numberp #'cdr) cycles)
                 (return-from outer (common-cycle cycles)))))))

(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"))))
  (is (= 215252378794009 (solver2))))