day19.lisp (7292B)
1 (defpackage #:adventofcode2022/day19 2 (:use #:cl #:adventofcode2022) 3 (:import-from #:cl-ppcre 4 #:register-groups-bind)) 5 (in-package #:adventofcode2022/day19) 6 7 (defun get-resource-index (resource) 8 (cond 9 ((eq resource :ore) 0) 10 ((eq resource :clay) 1) 11 ((eq resource :obsidian) 2) 12 ((eq resource :geode) 3) 13 (t (error "Unknown resource type ~S" resource)))) 14 15 (defun getres (resource &optional field) 16 (if field 17 (aref field (get-resource-index resource)) 18 (lambda (x) (getres resource x)))) 19 20 (defun (setf getres) (value resource field) 21 (setf (elt field (get-resource-index resource)) value)) 22 23 (defun %res-op (op resources-1 resources-2) 24 (let* ((length (length resources-1)) 25 (new (make-array length))) 26 (loop for i from 0 below length 27 do (setf (aref new i) 28 (funcall op 29 (aref resources-1 i) 30 (aref resources-2 i)))) 31 new)) 32 33 (declaim (inline res+)) 34 (defun res+ (resources-1 resources-2) 35 (%res-op #'+ resources-1 resources-2)) 36 37 (declaim (inline res-)) 38 (defun res- (resources-1 resources-2) 39 (%res-op #'- resources-1 resources-2)) 40 41 (defun can-build-robot-p (blueprint resources) 42 (loop with depends = blueprint 43 for i from 0 below (length depends) 44 always (>= (aref resources i) (aref depends i)))) 45 46 (defun build-robot (type blueprints robots resources) 47 (let ((robots-delta (vector 0 0 0 0))) 48 (incf (getres type robots-delta)) 49 (values 50 (res+ robots robots-delta) 51 (res- resources blueprints)))) 52 53 (defparameter *max-geodes-cache* nil) 54 (defparameter *max-geode-by-minute-cache* nil) 55 56 (defun compute-cache-key (remaining-minutes robots resources) 57 "This is a lot faster than puttin lists in 'equal tables." 58 (logior 59 (getres :ore resources) 60 (ash (getres :clay resources) 16) 61 (ash (getres :obsidian resources) 32) 62 (ash (getres :geode resources) 48) 63 (ash (getres :ore robots) 64) 64 (ash (getres :clay robots) 80) 65 (ash (getres :obsidian robots) 96) 66 (ash (getres :geode robots) 112) 67 (ash remaining-minutes 128))) 68 69 (defun max-geodes-for-blueprint (blueprint max-bots &optional (remaining-minutes 24) (robots (vector 1 0 0 0)) (resources (vector 0 0 0 0))) 70 (when (<= remaining-minutes 0) 71 (return-from max-geodes-for-blueprint (getres :geode resources))) 72 (let* ((key (compute-cache-key remaining-minutes robots resources)) 73 (cached (gethash key *max-geodes-cache*)) 74 (current-geodes (getres :geode resources))) 75 (when cached 76 (return-from max-geodes-for-blueprint cached)) 77 (when (< current-geodes (or (gethash remaining-minutes *max-geode-by-minute-cache*) 0)) 78 (return-from max-geodes-for-blueprint 0)) 79 (setf (gethash remaining-minutes *max-geode-by-minute-cache*) current-geodes) 80 (let ((produced (copy-seq robots)) 81 (results) 82 (best-result)) 83 (when (loop for type in '(:geode :obsidian :clay :ore) 84 for robot-bp = (getres type blueprint) 85 when (and (< (getres type robots) (getres type max-bots)) 86 (can-build-robot-p robot-bp resources)) 87 do (multiple-value-bind (new-robots new-resources) 88 (build-robot type robot-bp robots resources) 89 (push (max-geodes-for-blueprint blueprint 90 max-bots 91 (1- remaining-minutes) 92 new-robots 93 (res+ new-resources produced)) 94 results) 95 (when (eq type :geode) 96 (return nil))) 97 finally (return t)) 98 (push (max-geodes-for-blueprint blueprint 99 max-bots 100 (1- remaining-minutes) 101 robots 102 (res+ resources produced)) 103 results)) 104 (setf best-result (apply #'max results)) 105 (setf (gethash key *max-geodes-cache*) best-result)))) 106 107 (defun get-max-robots (blueprint) 108 (vector (apply #'max (map 'list (getres :ore) blueprint)) 109 (apply #'max (map 'list (getres :clay) blueprint)) 110 (apply #'max (map 'list (getres :obsidian) blueprint)) 111 9999)) 112 113 (defun task1 (inputs) 114 (loop for input in inputs 115 for blueprint = (cadr input) 116 for max-robots = (get-max-robots blueprint) 117 sum (let ((*max-geodes-cache* (make-hash-table)) 118 (*max-geode-by-minute-cache* (make-hash-table))) 119 (let ((max-geodes (max-geodes-for-blueprint blueprint max-robots))) 120 (* (car input) max-geodes))))) 121 122 (defun task2 (inputs) 123 (apply #'* 124 (loop for input in (subseq inputs 0 (min 3 (length inputs))) 125 for blueprint = (cadr input) 126 for max-robots = (get-max-robots blueprint) 127 collect (let ((*max-geodes-cache* (make-hash-table)) 128 (*max-geode-by-minute-cache* (make-hash-table))) 129 (let ((max-geodes (max-geodes-for-blueprint blueprint max-robots 32))) 130 max-geodes))))) 131 132 (define-day 19 133 (:translate-input (lambda (input) 134 (let* ((label-rules (str:split ":" input :limit 2)) 135 (id (parse-integer (cadr (str:split " " (car label-rules))))) 136 (rules (str:split "." (cadr label-rules) :omit-nulls t))) 137 (list id 138 (loop with robots = (vector 139 (vector 0 0 0 0) 140 (vector 0 0 0 0) 141 (vector 0 0 0 0) 142 (vector 0 0 0 0)) 143 for rule in rules 144 do (register-groups-bind (type-str rest) 145 ("Each (.*?) robot costs (.*)" rule) 146 (let* ((type (intern (str:upcase type-str) :keyword)) 147 (robot (getres type robots))) 148 (loop for cost-str in (str:split "and" rest) 149 do (register-groups-bind (cost material) 150 ("(\\d+) (.*)" cost-str) 151 (let ((cost-int (parse-integer cost)) 152 (dependency (intern 153 (str:upcase (str:trim material)) 154 :keyword))) 155 (setf (getres dependency robot) cost-int)))))) 156 finally (return robots)))))) 157 #'task1 158 #'task2)