Clean up

1 files changed, 92 insertions, 187 deletions

diff --git a/AoC2022/19/solver.lisp b/AoC2022/19/solver.lisp
index d3af8e0..9eff775 100644
--- a/AoC2022/19/solver.lisp
+++ b/AoC2022/19/solver.lisp
@@ -1,8 +1,7 @@
 (ql:quickload '(fiveam uiop cl-ppcre fset lparallel arrows))
-;; (setf lparallel:*kernel* (lparallel:make-kernel 8))
-
-;; (declaim (optimize (speed 0) (space 0) (debug 3)))
+(setf lparallel:*kernel* (lparallel:make-kernel 8))
 
+(defparameter *materials* '(:geode :obsidian :clay :ore))
 (defun material (string)
   (cond
     ((string= string "ore") :ore)
@@ -19,228 +18,134 @@
                      first-material))))))
 
 
-(defun can-build-robot-pm (requirements available)
-  (fset:subbag? requirements available))
+(defun can-build-robot-pm (requirements resources)
+  (fset:subbag? requirements resources))
 
-(defun consume (requirements available)
-  (fset:bag-difference available requirements))
+(defun consume (requirements resources)
+  (fset:bag-difference resources requirements))
 
-(defun material-collect (bots available-materials)
-  (fset:bag-sum bots available-materials))
+(defun material-collect (robots resources)
+  (fset:bag-sum robots resources))
+
+(defun resource-increase (current-state time-left)
+  (destructuring-bind (robots resources) current-state
+    (reduce (lambda (acc material)
+              (fset:with acc material
+                         (* time-left (fset:multiplicity robots material))))
+            *materials*
+            :initial-value resources)))
 
 (defun bot-requirements (type recipes)
   (fset:lookup recipes type))
 
-(defun next-step (build-next robots resources blueprints time-left)
-  (if (zerop time-left)
-      ;; (list robots resources)
-      (fset:multiplicity resources :geode)
-      ;; resources
-      (let ((req (bot-requirements build-next blueprints)))
-        (if (can-build-robot-pm req resources)
-            (let ((new-robots (fset:with robots build-next))
-                  (resources-left (consume req resources)))
-              (probe new-robots
-                     (material-collect robots resources-left)
-                     blueprints (1- time-left)))
-            (next-step build-next
-                       robots
-                       (material-collect robots resources)
-                       blueprints (1- time-left))))))
-
-(defun next-step2 (build-next robots resources blueprints)
-  (let ((req (bot-requirements build-next blueprints)))
+(defun build-robot (type robots resources recipes)
+  (let ((req (bot-requirements type recipes)))
     (when (can-build-robot-pm req resources)
-      (let ((new-robots (fset:with robots build-next))
+      (let ((new-robots (fset:with robots type))
             (resources-left (consume req resources)))
         (values new-robots (material-collect robots resources-left))))))
 
-(defun probe2 (current-state blueprints)
+(defun max-cost (recipes)
+  (fset:reduce
+   (lambda (acc key value)
+     (declare (ignore key))
+     (fset:union value acc))
+   recipes
+   :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 max-costs)
+  (loop for try in (can-build bots)
+        when (or (eq :geode try)
+                 (< (fset:multiplicity bots try) ;; every cycle I not yet produce
+                    (fset:multiplicity max-costs try))) ;; enough for any build
+          collect try))
+
+(defun probe (current-state recipes max-cost)
   (destructuring-bind (robots resources) current-state
-    (fset:reduce
+    (reduce
      (lambda (acc bot-type)
        (multiple-value-bind (new-robots new-resources)
-           (next-step2 bot-type
-                       robots
-                       resources
-                       blueprints)
+           (build-robot bot-type robots resources recipes)
          (if new-robots (fset:with acc (list new-robots new-resources)) acc)))
-     (propose-builds robots (max-cost blueprints))
+     (propose-builds robots max-cost)
      :initial-value (fset:set (list robots (material-collect robots resources))))))
 
-(defun advance (robot-resource-list blueprints)
+(defun advance (robot-resource-seq blueprints max-cost)
   (fset:reduce
    (lambda (new-states current-state)
      (fset:union new-states
-            (probe2 current-state blueprints)
-            ))
-   robot-resource-list
+            (probe current-state blueprints max-cost)))
+   robot-resource-seq
    :initial-value (fset:empty-set)))
 
-;; (resource-increase
-;;  (list (fset:bag :obsidian :ore) (fset:bag :clay)) 2)
-
 (defun materials> (m1 m2)
   (eq :greater
-      (fset:reduce (lambda (result material)
-                     (if (eq result :equal)
-                         (let ((c1 (fset:multiplicity m1 material))
-                               (c2 (fset:multiplicity m2 material)))
-                           (cond
-                             ((< c1 c2) :less)
-                             ((= c1 c2) :equal)
-                             ((> c1 c2) :greater)))
-                         result))
-                   '(:geode :obsidian :clay :ore)
-                   :initial-value :equal)))
-
-(defun leading-configs (robot-resource-list time-left truncate)
-  (let ((len (fset:size robot-resource-list)))
-    (format t "time-left: ~a, list: ~a~%" time-left len))
+      (reduce (lambda (result material)
+                (if (eq result :equal)
+                    (let ((c1 (fset:multiplicity m1 material))
+                          (c2 (fset:multiplicity m2 material)))
+                      (cond
+                        ((< c1 c2) :less)
+                        ((= c1 c2) :equal)
+                        ((> c1 c2) :greater)))
+                    result))
+              *materials*
+              :initial-value :equal)))
+
+(defun leading-configs (robot-resource-seq time-left truncate)
+  ;; (format t "~a~%" (fset:size robot-resource-seq))
   (fset:subseq
-   (fset:sort robot-resource-list
+   (fset:sort robot-resource-seq
               #'materials> :key (lambda (state) (resource-increase state time-left)))
    0 truncate))
 
-(fset:subseq
- (fset:sort (fset:set 5 4 4 5 8 2) #'> ) 0 15)
-
-;; (materials< (fset:bag :clay) (fset:bag :obsidian :ore))
-
-(defun resource-increase (current-state time-left)
-  (destructuring-bind (robots resources) current-state
-    (reduce (lambda (acc material)
-              (fset:with acc material
-                         (* time-left (fset:multiplicity robots material))))
-            '(:geode :obsidian :clay :ore)
-            :initial-value resources)))
-
-(defun find-best (robot-resource-list blueprints time-left state-truncation)
+(defun find-best (robot-resource-seq blueprints time-left &optional (state-truncation 1024) (max-cost (max-cost blueprints)))
   (if (zerop time-left)
-      (arrows:-> robot-resource-list
-                 (fset:subseq 0 3)
-                 ;; (cadar)
-                 ;; (fset:multiplicity :geode)
-                 )
+      (arrows:-> robot-resource-seq
+                 ;; (fset:subseq 0 3)
+                 (fset:first)
+                 (cadr)
+                 (fset:multiplicity :geode))
       (find-best (leading-configs
-                  (advance robot-resource-list blueprints)
+                  (advance robot-resource-seq blueprints max-cost)
                   (1- time-left) state-truncation)
-                 blueprints (1- time-left) state-truncation)))
-
-(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 #'max
-          (mapcar
-           (lambda (next)
-             (next-step next
-                        robots
-                        resources
-                        blueprints time-left))
-           (propose-builds robots (max-cost blueprints)))))
+                 blueprints (1- time-left)
+                 state-truncation
+                 max-cost)))
 
 (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)))))))
+       (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)))
-
-(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)))
+                  (lambda (recipes)
+                    (find-best (fset:seq (list (fset:bag :ore) (fset:empty-bag)))
+                               recipes time-left 1024))
                   blueprints))
 
-(let ((factory (cdar (get-blueprints "/home/titan/dev/scratch/AoC2022/19/eg-in")))
-      (time-left 30))
-  ;; (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)
-  ;;  )
-  ;; (max-cost factory)
-  (time
-   (find-best (list (list (fset:bag :ore) (fset:bag))) factory 32 1024))
-  )
-
-
-;; (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 "/home/titan/dev/scratch/AoC2022/19/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)))
-;;   )
+(defun part1 (blueprints time-left)
+  (loop for geodes in (solver blueprints time-left)
+        for idx from 1
+        sum (* idx geodes)))
+
+(defun part2 (blueprints time-left)
+  (apply #'* (solver blueprints time-left)))
+
+(fiveam:test solution
+  ;; part1
+  (fiveam:is (= 33 (part1 (get-blueprints "eg-in") 24)))
+  (fiveam:is (= 1266 (part1 (get-blueprints "input") 24)))
+  ;; part1
+  (fiveam:is (= 3472 (part2 (get-blueprints "eg-in") 32)))
+  (fiveam:is (= 5800 (part2 (subseq (get-blueprints "input") 0 3) 32))))