(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))))