From e047b0a2b8612299e3e74f23ad99c154cfdc8e6e Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Wed, 20 Dec 2023 10:26:55 +0100
Subject: part2

---
 AoC2023/day19/solver.lisp | 86 ++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 85 insertions(+), 1 deletion(-)

(limited to 'AoC2023/day19/solver.lisp')

diff --git a/AoC2023/day19/solver.lisp b/AoC2023/day19/solver.lisp
index 9c2f0a0..98bfd64 100644
--- a/AoC2023/day19/solver.lisp
+++ b/AoC2023/day19/solver.lisp
@@ -3,13 +3,28 @@
 ;;
 (ql:quickload '(fiveam cl-ppcre arrows))
 
-(defstruct part
+(defstruct (part (:copier nil))
   x m a s)
 
 (defun part-sum (part)
   (with-slots (x m a s) part
     (+ x m a s)))
 
+(defun copy-part (range-part)
+  (with-slots (x m a s) range-part
+    (make-part :x (copy-tree x)
+               :m (copy-tree m)
+               :a (copy-tree a)
+               :s (copy-tree s))))
+
+(defun part-options (range-part)
+  (with-slots (x m a s) range-part
+    (reduce #'*
+            (list x m a s)
+            :key (lambda (v)
+                   (destructuring-bind (st . end) v
+                     (1+ (- end st)))))))
+
 (defun solve (filename)
   (let ((workflows (make-hash-table))
         parts)
@@ -57,4 +72,73 @@
            (part-sum part))
           ((eq 'R out) 0)
           ((test-part workflows part out)))))
+
+
+(defun part-2 (workflows start range)
+  (if (member start '(A R))
+      (list start range)
+      (destructuring-bind (df . opts) (cdr (assoc start workflows))
+        (let ((drops (loop for (op prop val target) in opts
+                           append
+                           (destructuring-bind (st . end) (slot-value range prop)
+                             (if (eq '< op)
+                                 (cond ((< end val) (part-2 workflows target (copy-part range)))
+                                       ((<= val st) nil)
+                                       (t (let ((lf (copy-part range)))
+                                            (setf (slot-value lf prop) (cons st (1- val))
+                                                  (slot-value range prop) (cons val end))
+                                            (part-2 workflows target lf))))
+                                 (cond ((> st val) (part-2 workflows target (copy-part range)))
+                                       ((>= val end) nil)
+                                       (t (let ((rt (copy-part range)))
+                                            (setf (slot-value range prop) (cons st val)
+                                                  (slot-value rt prop) (cons (1+ val) end))
+                                            (part-2 workflows target rt)))))
+
+
+                             ))))
+
+          (append
+           (part-2 workflows df range)
+           drops
+           )))))
+
+(defun solve2 (filename)
+  (let ((workflows))
+    (loop for line in (uiop:read-file-lines filename)
+          do
+             (unless (or (string-equal line "") (eq #\{ (aref line 0)))
+               (cl-ppcre:register-groups-bind ((#'read-from-string name) (#'parse-tests tests) (#'read-from-string default))
+                   ("\(\\w+\){\(.*\),\(\\w+\)}" line)
+                 (push
+                  (list* name default tests )
+
+                  workflows))))
+    ;; workflows
+    (final-options
+     (part-2 workflows
+             'in (make-part :x (cons 1 4000)
+                            :m (cons 1 4000)
+                            :a (cons 1 4000)
+                            :s (cons 1 4000))))))
+
+
+(fiveam:test solutions2
+  (fiveam:is (= 167409079868000 (solve2 "eg-in")))
+  (fiveam:is (= 130090458884662 (solve2 "input"))))
+
+(defun final-options (solutions)
+  (loop for (r p) on solutions
+          by #'cddr
+        when (eq r 'A)
+          sum (part-options p)))
+
+(fiveam:test parts2
+  (fiveam:is (= 256000000000000
+                (final-options (list 'a
+                                     (make-part :x (cons 1 4000)
+                                                :m (cons 1 4000)
+                                                :a (cons 1 4000)
+                                                :s (cons 1 4000)))))))
+
 (fiveam:run!)
-- 
cgit v1.2.3