diff options
| -rw-r--r-- | day19.lisp | 94 |
1 files changed, 40 insertions, 54 deletions
@@ -1,7 +1,5 @@ (defstruct problem workflows parts) -(defstruct part x m a s) - (defstruct rule var op value res) (defun read-rule (string) @@ -34,17 +32,12 @@ ht)) (defun read-part (string) - (let* ((x 0) (m 0) (a 0) (s 0)) - (loop for i = 0 then (1+ j) - as j = (position #\= string :start i) - while j - do (let ((num (parse-integer string :start (1+ j) :junk-allowed t)) - (chr (aref string (1- j)))) - (cond ((equal chr #\x) (setf x num)) - ((equal chr #\m) (setf m num)) - ((equal chr #\a) (setf a num)) - ((equal chr #\s) (setf s num))))) - (make-part :x x :m m :a a :s s))) + (loop for i = 0 then (1+ j) + as j = (position #\= string :start i) + while j + collect (let ((num (parse-integer string :start (1+ j) :junk-allowed t)) + (chr (aref string (1- j)))) + (cons chr num)))) (defun read-parts (stream) (loop for line = (read-line stream nil) @@ -55,30 +48,26 @@ (with-open-file (stream filespec) (make-problem :workflows (read-workflows stream) :parts (read-parts stream)))) -(defun part-accepted-p (part workflows) - (labels ((f (rules) - (loop for rule in rules - as rvar = (rule-var rule) - as rop = (rule-op rule) - as rvalue = (rule-value rule) - as rres = (rule-res rule) - if (let ((pvalue (cond ((equal rvar #\x) (part-x part)) - ((equal rvar #\m) (part-m part)) - ((equal rvar #\a) (part-a part)) - ((equal rvar #\s) (part-s part))))) - (or (not rvar) - (and (equal rop #\<) (< pvalue rvalue)) - (and (equal rop #\>) (> pvalue rvalue)))) - return (cond ((equalp rres "A") t) - ((equalp rres "R") nil) - (t (f (gethash rres workflows))))))) - (f (gethash "in" workflows)))) +(defun part-accepted-p (part workflows &optional (entry "in")) + (let ((rules (gethash entry workflows))) + (loop for rule in rules + as rvar = (rule-var rule) + as rop = (rule-op rule) + as rvalue = (rule-value rule) + as rres = (rule-res rule) + as pvalue = (assoc rvar part) + if (or (not rvar) + (and (equal rop #\<) (< (cdr pvalue) rvalue)) + (and (equal rop #\>) (> (cdr pvalue) rvalue))) + return (cond ((equalp rres "A") t) + ((equalp rres "R") nil) + (t (part-accepted-p part workflows rres)))))) (defun solve1 (filespec) (let ((problem (read-problem filespec))) (loop for p in (problem-parts problem) if (part-accepted-p p (problem-workflows problem)) - sum (+ (part-x p) (part-m p) (part-a p) (part-s p))))) + sum (reduce #'+ (mapcar #'cdr p))))) (defun range-size (range) (assert (<= (car range) (cdr range))) @@ -98,9 +87,8 @@ (subrange (1- value) #\> range) (subrange (1+ value) #\< range))) -(defun range-combinations (workflows rulename x m a s) - (cond ((equalp rulename "A") - (* (range-size x) (range-size m) (range-size a) (range-size s))) +(defun range-combinations (workflows rulename ranges) + (cond ((equalp rulename "A") (reduce #'* (mapcar #'range-size (mapcar #'cdr ranges)))) ((equalp rulename "R") 0) (t (let ((rules (gethash rulename workflows))) (loop for rule in rules @@ -108,33 +96,31 @@ as rop = (rule-op rule) as rvalue = (rule-value rule) as rres = (rule-res rule) - as range = (cond - ((equal rvar #\x) x) - ((equal rvar #\m) m) - ((equal rvar #\a) a) - ((equal rvar #\s) s)) + as range = (cdr (assoc rvar ranges)) as sub = (when rvalue (subrange rvalue rop range)) if sub - sum (range-combinations - workflows - rres - (if (equal rvar #\x) sub x) - (if (equal rvar #\m) sub m) - (if (equal rvar #\a) sub a) - (if (equal rvar #\s) sub s)) + sum (range-combinations workflows rres + (mapcar + (lambda (range) + (if (equal rvar (car range)) + (cons rvar sub) + range)) + ranges)) if (not rvar) - sum (range-combinations workflows rres x m a s) + sum (range-combinations workflows rres ranges) ;; update subrange - do (cond - ((equal rvar #\x) (setf x (inv-subrange rvalue rop range))) - ((equal rvar #\m) (setf m (inv-subrange rvalue rop range))) - ((equal rvar #\a) (setf a (inv-subrange rvalue rop range))) - ((equal rvar #\s) (setf s (inv-subrange rvalue rop range))))))))) + do (when rvar + (setf ranges (copy-tree ranges)) + (setf (cdr (assoc rvar ranges)) (inv-subrange rvalue rop range)))))))) (defun solve2 (filespec) (let* ((problem (read-problem filespec)) (workflows (problem-workflows problem))) - (range-combinations workflows "in" '(1 . 4000) '(1 . 4000) '(1 . 4000) '(1 . 4000)))) + (range-combinations workflows "in" + '((#\x . (1 . 4000)) + (#\m . (1 . 4000)) + (#\a . (1 . 4000)) + (#\s . (1 . 4000)))))) (print (solve1 "data/19/example.txt")) ;; 19114 (print (solve1 "data/19/input.txt")) ;; 495298 |