aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/19/solver.lisp
blob: 37b1e741c06be7d7a00c7749346ca7e10658aecf (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
(ql:quickload '(fiveam uiop cl-ppcre))


(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 plist-merge (func p1 p2 &optional default)
  "Merge 2 flat plists P1 & P2 by FUNC. Use DEFAULT when value is missing on one list."
  (flet ((keys (plist) (loop for key in plist by #'cddr collect key)))
    (loop for key in (union (keys p1) (keys p2))
          nconc (list key (funcall func (getf p1 key default) (getf p2 key default))))))

(defun max-costs (blueprint)
  (reduce
   (lambda (acc item)
     (plist-merge #'max acc item 0))
   (mapcar #'cdr blueprint)))

(defun can-build (recipes available-materials)
  (mapcan (lambda (bot-recipes)
            (when (can-build-robot-p (cdr bot-recipes) available-materials)
              (list (car bot-recipes))))
          recipes))

(defun should-build (blueprints robots)
  (let ((max-cost (max-costs blueprints)))
    (loop for (type amount) on robots by #'cddr
          when (or (eq type :geode)
                   (<= amount (getf max-cost type 0)))
            collect type)))

(defun try! (build-next robots resources blueprints)
  (let ((req (bot-requirements build-next blueprints)))
    (if (can-build-robot-p req resources)
      (values
       (consume req resources)
       (fset:with robots build-next))
      (values resources robots))))

(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)
            (reduce (lambda (max next)
                      (max max
                           (next-step next
                                      (fset:with robots build-next)
                                      (material-collect robots (consume req resources))
                                      blueprints (1- time-left))))
                    '(:geode :obsidian :clay :ore)
                    :initial-value 0)
            (next-step build-next
                       robots
                       (material-collect robots resources)
                       blueprints (1- time-left))))))

(defun start-resources ()
  ;; (list :ore 0 :clay 0 :obsidian 0 :geode 0)
  (fset:empty-bag))
(defun start-bots ()
  ;; (list :ore 1 :clay 0 :obsidian 0 :geode 0)
  (fset:bag :ore))

(let ((blueprints
        (cdar
         (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 "eg-in"))))
      ;; (materials '(:ore 8 :clay 20))
      (materials (start-resources))
      (bots (start-bots))
      ;; (bots '(:geode 1 :ore 8 :clay 20))
      (time-left 24))


  (next-step :clay bots materials blueprints time-left)
  )