From cb18eee3b9ee962f9a506ab9d2084df3b3f8f582 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Thu, 12 Jan 2023 18:23:20 +0100
Subject: Clean up
---
AoC2022/19/solver.lisp | 279 ++++++++++++++++---------------------------------
1 file changed, 92 insertions(+), 187 deletions(-)
(limited to 'AoC2022')
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))))
--
cgit v1.2.3