aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/19/solver.lisp
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)))
;;   )