day-24.lisp (4832B)
1 (defpackage #:aoc/day-24 2 (:use #:cl #:aoc/utils) 3 (:export #:day-24)) 4 (in-package #:aoc/day-24) 5 6 (defstruct node 7 name 8 (value 0)) 9 10 (defstruct gate 11 type 12 inputs 13 output) 14 15 (defun parse-input (input) 16 (let ((nodes (make-hash-table :test #'equal))) 17 (loop for line = (read-line input) 18 until (= (length line) 0) 19 for colon = (position #\: line) 20 for node = (make-node :name (subseq line 0 colon) 21 :value (parse-integer line :start (+ colon 2))) 22 do (setf (gethash (node-name node) nodes) node)) 23 (values 24 (hash-table-values nodes) 25 (loop for line = (read-line input nil) 26 until (null line) 27 for parts = (uiop:split-string line :separator '(#\Space)) 28 for gate = (make-gate :type (eswitch ((nth 1 parts) :test #'string=) 29 ("OR" #'logior) 30 ("AND" #'logand) 31 ("XOR" #'logxor)) 32 :inputs (list (ensure-gethash (nth 0 parts) nodes 33 (make-node :name (nth 0 parts))) 34 (ensure-gethash (nth 2 parts) nodes 35 (make-node :name (nth 2 parts)))) 36 :output (ensure-gethash (nth 4 parts) nodes 37 (make-node :name (nth 4 parts)))) 38 collect gate) 39 nodes))) 40 41 (defun ready-gates (nodes gates) 42 (loop for gate in gates 43 when (every (lambda (node) 44 (member node nodes)) 45 (gate-inputs gate)) 46 collect gate)) 47 48 (defun run-gate (gate) 49 (setf (node-value (gate-output gate)) 50 (apply (gate-type gate) 51 (mapcar #'node-value 52 (gate-inputs gate))))) 53 54 (defun prefix-nodes (nodes prefix) 55 (sort (loop for node in nodes 56 when (char= (aref (node-name node) 0) prefix) 57 collect node) 58 #'string> 59 :key #'node-name)) 60 61 (defun run-all-gates (nodes gates) 62 (loop for ready = (ready-gates nodes gates) 63 until (null ready) 64 do (loop for gate in ready 65 do (run-gate gate) 66 (push (gate-output gate) nodes) 67 (setf gates (remove gate gates))) 68 finally (return (prefix-nodes nodes #\z)))) 69 70 (defun nodes-result (nodes) 71 (loop with result = 0 72 for node in nodes 73 do (setf result (ash result 1) 74 result (logior result (node-value node))) 75 finally (return result))) 76 77 (defun task-1 (nodes gates) 78 (nodes-result (run-all-gates nodes gates))) 79 80 (defun reset-values (nodes) 81 (loop for node in nodes 82 for f = (aref (node-name node) 0) 83 unless (or (char= f #\x) 84 (char= f #\y)) 85 do (setf (node-value node) 0))) 86 87 (defun find-gate-for-output (gates output) 88 (find output gates 89 :key #'gate-output)) 90 91 (defun swap-outputs (gates output-1 output-2) 92 (let ((gate-1 (find-gate-for-output gates output-1)) 93 (gate-2 (find-gate-for-output gates output-2))) 94 (psetf (gate-output gate-1) (gate-output gate-2) 95 (gate-output gate-2) (gate-output gate-1)))) 96 97 (defun function-name (function) 98 (cond 99 ((eq function #'logand) "AND") 100 ((eq function #'logior) "OR") 101 ((eq function #'logxor) "XOR") 102 (t "?"))) 103 104 (defun swap-all (all-nodes gates pairs) 105 (loop for pair in pairs 106 for nodes = (mapcar (rcurry #'gethash all-nodes) pair) 107 do (apply #'swap-outputs gates nodes))) 108 109 (defun task-2 (nodes gates) 110 (swap-all nodes gates 111 '(("mkk" "z10") 112 ("qbw" "z14") 113 ("wcb" "z34") 114 ("wjb" "cvp"))) 115 (with-open-file (s #P"out.dot" 116 :direction :output 117 :if-exists :supersede) 118 (format s "digraph {~%") 119 (loop for gate in gates 120 for gate-type = (function-name (gate-type gate)) 121 for gate-name = (format nil "~A_~A_~A" 122 (node-name (first (gate-inputs gate))) 123 gate-type 124 (node-name (second (gate-inputs gate)))) 125 do (format s "~A[label=\"~A\"];~%" gate-name gate-type) 126 (format s "~A -> ~A;~%" gate-name (node-name (gate-output gate))) 127 (loop for input in (gate-inputs gate) 128 do (format s "~A -> ~A;~%" (node-name input) gate-name))) 129 (format s "}~%")) 130 "cvp,mkk,qbw,wcb,wjb,z10,z14,z34") 131 132 (defun day-24 (input) 133 (multiple-value-bind (nodes gates all-nodes) 134 (parse-input input) 135 (values (task-1 nodes gates) 136 (task-2 all-nodes gates))))