solve day 19 part 1 LISP

1 files changed, 75 insertions, 32 deletions

diff --git a/AoC2022/19/solver.lisp b/AoC2022/19/solver.lisp
index 083a093..89234f4 100644
--- a/AoC2022/19/solver.lisp
+++ b/AoC2022/19/solver.lisp
@@ -1,4 +1,5 @@
-(ql:quickload '(fiveam uiop cl-ppcre))
+(ql:quickload '(fiveam uiop cl-ppcre fset lparallel))
+(setf lparallel:*kernel* (lparallel:make-kernel 8))
 
 
 (defun material (string)
@@ -46,36 +47,78 @@
                        (material-collect robots resources)
                        blueprints (1- time-left))))))
 
+(defun max-cost (blueprint)
+  (fset:reduce
+   (lambda (acc key value)
+     (declare (ignore key))
+     (fset:union value acc))
+   blueprint
+   :initial-value (fset:empty-bag)))
+
+(defun can-build (bots)
+  (append
+   (list :clay :ore)
+   (when (plusp (fset:multiplicity bots :clay)) (list :obsidian))
+   (when (plusp (fset:multiplicity bots :obsidian)) (list :geode))))
+
+(defun propose-builds (bots costs)
+  (loop for try in (can-build bots)
+        when (or (eq :geode try)
+                 (< (fset:multiplicity bots try)
+                    (fset:multiplicity costs try)))
+          collect try))
+
 (defun probe (robots resources blueprints time-left)
-  (reduce (lambda (max next)
-            (max max
-                 (next-step next
-                            robots
-                            resources
-                            blueprints time-left)))
-          '(:geode :obsidian :clay :ore)
-          :initial-value 0))
-
-(defun start-resources ()
-  ;; (list :ore 0 :clay 0 :obsidian 0 :geode 0)
-  (fset:empty-bag))
-(defun start-bots ()
-  ;; (list :ore 1 :clay 0 :obsidian 0 :geode 0)
-  (fset:bag :ore))
-
-(let ((blueprints
-        (cdar
-         (mapcar
-          (lambda (l)
-            (let ((blueprint (uiop:split-string l :separator ":.")))
-              (cons (car blueprint)
-                    (reduce #'fset:map-union
-                            (mapcar #'parse-robot-recipe (butlast (cdr blueprint)))))))
-          (uiop:read-file-lines "eg-in"))))
-      ;; (materials '(:ore 8 :clay 20))
-      (materials (start-resources))
-      (bots (start-bots))
-      ;; (bots '(:geode 1 :ore 8 :clay 20))
-      (time-left 24))
-      (probe bots materials blueprints time-left)
+  (reduce #'max
+          (mapcar
+           (lambda (next)
+             (next-step next
+                        robots
+                        resources
+                        blueprints time-left))
+           (propose-builds robots (max-cost blueprints)))))
+
+(defun get-blueprints (filename)
+  (mapcar
+   (lambda (l)
+     (let ((blueprint (uiop:split-string l :separator ":.")))
+       (cons (car blueprint)
+             (reduce #'fset:map-union
+                     (mapcar #'parse-robot-recipe (butlast (cdr blueprint)))))))
+   (uiop:read-file-lines filename)))
+
+(defun solver (blueprints time-left)
+  (apply #'+
+         (lparallel:pmap 'list
+                         (lambda (bp)
+                           (destructuring-bind (name . recipes) bp
+                             (* (parse-integer name :start 10)
+                                (probe (fset:bag :ore) (fset:empty-bag) recipes time-left))))
+                         blueprints)))
+(fiveam:test solution
+  ;; part1
+  (fiveam:is (= 33 (solver (get-blueprints "eg-in") 24)))
+  (fiveam:is (= 1266 (solver (get-blueprints "input") 24)))
   )
+
+;; (let ((blueprints
+;;         ;; (cdadr)
+;;         (get-blueprints "input")
+;;         )
+;;       ;; (materials '(:ore 8 :clay 20))
+;;       (materials (start-resources))
+;;       (bots (start-bots))
+;;       ;; (bots '(:geode 1 :ore 8 :clay 20))
+;;       (time-left 24))
+;;   (time
+;;    (apply #'+
+;;           (lparallel:pmap 'list
+;;                           (lambda (bp)
+;;                             (destructuring-bind (name . recipes) bp
+;;                               (* (parse-integer name :start 10)
+;;                                  (probe bots materials recipes time-left))))
+;;                           blueprints)))
+
+;;   ;; (time
+;;   ;;  (print (probe bots materials blueprints 24)))
+;;   )