day-19.lisp (4269B)
1 (defpackage #:aoc/day-19 2 (:use #:cl #:aoc/utils) 3 (:export #:day-19)) 4 (in-package #:aoc/day-19) 5 6 (defstruct part 7 (x 0 :type fixnum) 8 (m 0 :type fixnum) 9 (a 0 :type fixnum) 10 (s 0 :type fixnum)) 11 12 (defun char-part-slot (char) 13 (ecase char 14 (#\x 'x) 15 (#\m 'm) 16 (#\a 'a) 17 (#\s 's))) 18 19 (defun parse-condition (line start end) 20 (let ((slot (char-part-slot (aref line start))) 21 (op (aref line (1+ start)))) 22 (list (case op 23 (#\< '<) 24 (#\> '>)) 25 slot 26 (parse-integer line 27 :start (+ start 2) 28 :end end)))) 29 30 (defun parse-workflow (line) 31 (let ((start-pos (position #\{ line))) 32 (list (subseq line 0 start-pos) 33 (loop for pos from (1+ start-pos) below (length line) 34 for end = (or (position #\, line :start pos) 35 (position #\} line :start pos)) 36 for then-pos = (position #\: line :start pos :end end) 37 if then-pos 38 collect (list (parse-condition line pos then-pos) 39 (subseq line (1+ then-pos) end)) 40 else 41 collect (list t (subseq line pos end)) 42 do (setf pos end))))) 43 44 (defun parse-workflows (input) 45 (loop for line = (read-line input nil) 46 while (and line (> (length line) 0)) 47 collect (parse-workflow line))) 48 49 (defun parse-part (line) 50 (loop with part = (make-part) 51 for pos from 1 below (length line) 52 for field = (aref line pos) 53 for (value end) = (multiple-value-list 54 (parse-integer line 55 :start (+ pos 2) 56 :junk-allowed t)) 57 do (setf pos end) 58 do (setf (slot-value part (char-part-slot field)) 59 value) 60 finally (return part))) 61 62 (defun parse-parts (input) 63 (loop for line = (read-line input nil) 64 while line 65 collect (parse-part line))) 66 67 (defun parse-input (input) 68 (values (parse-workflows input) 69 (parse-parts input))) 70 71 (defun compile-workflows (workflows) 72 (let ((ht (make-hash-table)) 73 (syms (make-hash-table :test 'equal))) 74 (labels ((make-workflow-symbol (name) 75 (or (gethash name syms) 76 (setf (gethash name syms) 77 (make-symbol (string-upcase name))))) 78 (call-workflow (sym part) 79 (funcall (gethash sym ht) part))) 80 (loop for (name conditions) in workflows 81 for name-symbol = (make-workflow-symbol name) 82 do (setf (gethash name-symbol ht) 83 (eval `(lambda (part) 84 (cond 85 ,@(loop for (condition then) in conditions 86 unless (eq condition t) 87 do (setf (second condition) 88 (ecase (second condition) 89 (x `(part-x part)) 90 (m `(part-m part)) 91 (a `(part-a part)) 92 (s `(part-s part)))) 93 do (setf then (cond 94 ((string= then "A") t) 95 ((string= then "R") nil) 96 (t `(funcall ,#'call-workflow 97 ',(make-workflow-symbol then) 98 part)))) 99 collect (list condition then))))))) 100 (gethash (make-workflow-symbol "in") ht)))) 101 102 (defun day-19 (input) 103 (multiple-value-bind (workflows parts) 104 (parse-input input) 105 (loop with in = (compile-workflows workflows) 106 for part in parts 107 when (funcall in part) 108 sum (+ (part-x part) 109 (part-m part) 110 (part-a part) 111 (part-s part)))))