blob: 89234f488626e176bbcdf22344a45949adcf37c6 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
(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)))
;; )
|