day19 use association listHEADmaster

1 files changed, 40 insertions, 54 deletions

diff --git a/day19.lisp b/day19.lisp
index 8011426..0543a76 100644
--- a/day19.lisp
+++ b/day19.lisp
@@ -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