preliminary stack of states

1 files changed, 81 insertions, 5 deletions

diff --git a/AoC2022/19/solver.lisp b/AoC2022/19/solver.lisp
index 89234f4..7617628 100644
--- a/AoC2022/19/solver.lisp
+++ b/AoC2022/19/solver.lisp
@@ -1,6 +1,7 @@
 (ql:quickload '(fiveam uiop cl-ppcre fset lparallel))
-(setf lparallel:*kernel* (lparallel:make-kernel 8))
+;; (setf lparallel:*kernel* (lparallel:make-kernel 8))
 
+(declaim (optimize (speed 0) (space 0) (debug 3)))
 
 (defun material (string)
   (cond
@@ -18,7 +19,7 @@
                      first-material))))))
 
 
-(defun can-build-robot-p (requirements available)
+(defun can-build-robot-pm (requirements available)
   (fset:subbag? requirements available))
 
 (defun consume (requirements available)
@@ -36,7 +37,7 @@
       (fset:multiplicity resources :geode)
       ;; resources
       (let ((req (bot-requirements build-next blueprints)))
-        (if (can-build-robot-p req resources)
+        (if (can-build-robot-pm req resources)
             (let ((new-robots (fset:with robots build-next))
                   (resources-left (consume req resources)))
               (probe new-robots
@@ -47,6 +48,59 @@
                        (material-collect robots resources)
                        blueprints (1- time-left))))))
 
+  (if (zerop time-left)
+      (values robots resources time-left))
+
+(defun next-step2 (build-next robots resources blueprints)
+  (let ((req (bot-requirements build-next blueprints)))
+    (when (can-build-robot-pm req resources)
+      (let ((new-robots (fset:with robots build-next))
+            (resources-left (consume req resources)))
+        (values new-robots (material-collect robots resources-left))))))
+
+
+(let ((factory (cdar (get-blueprints "/home/titan/dev/scratch/AoC2022/19/eg-in"))))
+  ;; (next-step2 :clay (fset:bag :ore) (fset:bag :ore :ore) factory)
+  ;; (probe2 (list (fset:bag :ore :clay) (fset:bag :ore :ore)) factory)
+  ;; (arrows:->
+  ;;  (list (list (fset:bag :ore :clay) (fset:bag :ore :ore)))
+  ;;  (advance factory)
+  ;;  (advance factory)
+  ;;  (advance factory)
+  ;;  (advance factory)
+  ;;  (advance factory)
+  ;;  (advance factory)
+  ;;  (advance factory)
+  ;;  )
+  (find-best (list (list (fset:bag :ore) (fset:bag))) factory 9))
+
+(defun probe2 (current-state blueprints)
+  (destructuring-bind (robots resources) current-state
+    (reduce
+     (lambda (acc bot-type)
+       (multiple-value-bind (new-robots new-states)
+           (next-step2 bot-type
+                       robots
+                       resources
+                       blueprints)
+         (if new-robots (cons (list new-robots new-states) acc) acc)))
+     (propose-builds robots (max-cost blueprints))
+     :initial-value (list (list robots (material-collect robots resources))))))
+
+(defun advance (robot-resource-list blueprints)
+  (reduce
+   (lambda (new-states current-state)
+     (union new-states
+            (probe2 current-state blueprints)
+            :test #'equal))
+   robot-resource-list
+   :initial-value nil))
+
+(defun find-best (robot-resource-list blueprints time-left)
+  (if (zerop time-left)
+      robot-resource-list
+      (find-best (advance robot-resource-list blueprints) blueprints (1- time-left))))
+
 (defun max-cost (blueprint)
   (fset:reduce
    (lambda (acc key value)
@@ -95,10 +149,32 @@
                              (* (parse-integer name :start 10)
                                 (probe (fset:bag :ore) (fset:empty-bag) recipes time-left))))
                          blueprints)))
+
+(defun solver2 (blueprints time-left)
+  (lparallel:pmap 'list
+                  (lambda (bp)
+                    (destructuring-bind (name . recipes) bp
+                      (declare (ignore name))
+                      (probe (fset:bag :ore) (fset:empty-bag) recipes time-left)))
+                  blueprints))
+
+;; (require :sb-sprof)
+;; (progn
+;;   (sb-sprof:start-profiling)
+;;   (time
+;;    (probe (fset:bag :ore) (fset:empty-bag) (cdar (get-blueprints "eg-in")) 25))
+;;   (sb-sprof:stop-profiling)
+;;   (sb-sprof:report))
+
+(step
+ (probe (fset:bag :ore) (fset:empty-bag) (cdar (get-blueprints "/home/titan/dev/scratch/AoC2022/19/eg-in")) 22))
+
+
+
 (fiveam:test solution
   ;; part1
-  (fiveam:is (= 33 (solver (get-blueprints "eg-in") 24)))
-  (fiveam:is (= 1266 (solver (get-blueprints "input") 24)))
+  ;; (fiveam:is (= 33 (solver (get-blueprints "eg-in") 24)))
+  (fiveam:is (= 1266 (solver (get-blueprints "/home/titan/dev/scratch/AoC2022/19/input") 24)))
   )
 
 ;; (let ((blueprints