diff options
Diffstat (limited to 'AoC2022/19/solver.lisp')
| -rw-r--r-- | AoC2022/19/solver.lisp | 279 |
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)))) |