diff options
Diffstat (limited to 'day19.lisp')
| -rw-r--r-- | day19.lisp | 144 |
1 files changed, 144 insertions, 0 deletions
diff --git a/day19.lisp b/day19.lisp new file mode 100644 index 0000000..8011426 --- /dev/null +++ b/day19.lisp @@ -0,0 +1,144 @@ +(defstruct problem workflows parts) + +(defstruct part x m a s) + +(defstruct rule var op value res) + +(defun read-rule (string) + (if (not (position #\: string)) + (make-rule :res (subseq string 0 (1- (length string)))) + (multiple-value-bind (value ind) (parse-integer string :start 2 :junk-allowed t) + (make-rule :var (aref string 0) + :op (aref string 1) + :value value + :res (subseq string (1+ ind)))))) + +(defun split-by-char (char string &key (start 0)) + (loop for i = start then (1+ j) + as j = (position char string :start i) + collect (subseq string i j) + while j)) + +(defun read-workflow (string) + (let* ((aux (position #\{ string)) + (name (subseq string 0 aux)) + (rules (mapcar #'read-rule (split-by-char #\, string :start (1+ aux))))) + (cons name rules))) + +(defun read-workflows (stream) + (let ((ht (make-hash-table :test #'equalp))) + (loop for line = (read-line stream nil) + while (> (length line) 0) + do (let ((workflow (read-workflow line))) + (setf (gethash (car workflow) ht) (cdr workflow)))) + 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))) + +(defun read-parts (stream) + (loop for line = (read-line stream nil) + while line + collect (read-part line))) + +(defun read-problem (filespec) + (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 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))))) + +(defun range-size (range) + (assert (<= (car range) (cdr range))) + (1+ (- (cdr range) (car range)))) + +(defun subrange (value op range) + (if + (equal op #\<) + (when (< (car range) value) + (cons (car range) (min (cdr range) (1- value)))) + (when (> (cdr range) value) + (cons (max (car range) (1+ value)) (cdr range))))) + +(defun inv-subrange (value op range) + (if + (equal op #\<) + (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))) + ((equalp rulename "R") 0) + (t (let ((rules (gethash rulename 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 range = (cond + ((equal rvar #\x) x) + ((equal rvar #\m) m) + ((equal rvar #\a) a) + ((equal rvar #\s) s)) + 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)) + if (not rvar) + sum (range-combinations workflows rres x m a s) + ;; 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))))))))) + +(defun solve2 (filespec) + (let* ((problem (read-problem filespec)) + (workflows (problem-workflows problem))) + (range-combinations workflows "in" '(1 . 4000) '(1 . 4000) '(1 . 4000) '(1 . 4000)))) + +(print (solve1 "data/19/example.txt")) ;; 19114 +(print (solve1 "data/19/input.txt")) ;; 495298 +(print (solve2 "data/19/example.txt")) ;; 167409079868000 +(print (solve2 "data/19/input.txt")) ;; 132186256794011 + + |