path: root/day19.lisp

(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