(ql:quickload '(fiveam uiop cl-ppcre fset lparallel)) (setf lparallel:*kernel* (lparallel:make-kernel 8)) (defun material (string) (cond ((string= string "ore") :ore) ((string= string "clay") :clay) ((string= string "obsidian") :obsidian) ((string= string "geode") :geode))) (defun parse-robot-recipe (line) (cl-ppcre:register-groups-bind ((#'material robot) (#'parse-integer fq) (#'material fm) (#'parse-integer sq) (#'material sm)) ("(\\w+) robot costs (\\d+) (\\w+)(?: and (\\d+) (\\w+))?" line) (let ((first-material (fset:with (fset:empty-bag) fm fq))) (fset:map (robot (if sm (fset:with first-material sm sq) first-material)))))) (defun can-build-robot-p (requirements available) (fset:subbag? requirements available)) (defun consume (requirements available) (fset:bag-difference available requirements)) (defun material-collect (bots available-materials) (fset:bag-sum bots available-materials)) (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-p 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 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))))) (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))) ;; )