day16.lisp (6504B)
1 (defpackage #:adventofcode2022/day16 2 (:use #:cl #:adventofcode2022) 3 (:import-from #:alexandria 4 #:define-constant 5 #:hash-table-values 6 #:map-combinations) 7 (:import-from #:cl-ppcre 8 #:register-groups-bind) 9 (:import-from #:queues 10 #:make-queue 11 #:qpush 12 #:qpop)) 13 (in-package #:adventofcode2022/day16) 14 15 (define-constant +input-line-regex+ 16 "Valve ([^ ]+) .* rate=(\\d+); .* valves? (.*)" 17 :test 'equal) 18 19 (defclass valve () 20 ((vid :initarg :vid 21 :reader vid) 22 (bid :initarg :bid 23 :reader bid) 24 (rate :initarg :rate 25 :accessor rate) 26 (next-valves :accessor next-valves))) 27 28 (defun make-graph (inputs) 29 (let ((valves (make-hash-table))) 30 (loop for input in inputs 31 for bit from 0 32 do (setf (gethash (car input) valves) 33 (make-instance 'valve 34 :vid (car input) 35 :bid (ash 1 bit) 36 :rate (cadr input)))) 37 (loop for input in inputs 38 for valve = (gethash (car input) valves) 39 for next-valves = (mapcar (lambda (id) 40 (gethash id valves)) 41 (caddr input)) 42 do (setf (next-valves valve) next-valves)) 43 (values (gethash :AA valves) 44 (loop with ht = (make-hash-table) 45 for valve being the hash-value of valves 46 do (setf (gethash (bid valve) ht) valve) 47 finally (return ht)) 48 (reduce #'logior 49 (mapcar #'bid 50 (remove-if (lambda (valve) 51 (= (rate valve) 0)) 52 (hash-table-values valves))))))) 53 54 (defun get-active-bits (integer) 55 (loop for i below (integer-length integer) 56 when (logbitp i integer) 57 collect (ash 1 i))) 58 59 (defparameter *distance-cache* nil) 60 61 (defun find-shortest-path (from to) 62 (let* ((key (cons (bid from) (bid to))) 63 (cached (gethash key *distance-cache*))) 64 (unless (null cached) 65 (return-from find-shortest-path cached)) 66 (let ((shortest-path 67 (loop named outer 68 with queue = (make-queue :simple-queue) 69 initially (qpush queue (list 0 from)) 70 while t 71 for (length node) = (qpop queue) 72 do (loop for next-node in (next-valves node) 73 when (eq to next-node) 74 do (return-from outer (1+ length)) 75 do (qpush queue (list (1+ length) next-node)))))) 76 (setf (gethash key *distance-cache*) shortest-path)))) 77 78 (defparameter *pressure-cache* nil) 79 80 (defun calculate-max-pressure (valve-map current-valve unopened-valves remaining-minutes) 81 (if (or (<= remaining-minutes 0) 82 (= unopened-valves 0)) 83 0 84 (loop for unopened-valve-bid in (get-active-bits unopened-valves) 85 for unopened-valve = (gethash unopened-valve-bid valve-map) 86 for path-length = (find-shortest-path current-valve unopened-valve) 87 for remaining-minutes-new = (- remaining-minutes path-length 1) 88 when (> remaining-minutes-new 0) 89 maximize (+ (* (rate unopened-valve) remaining-minutes-new) 90 (get-max-pressure valve-map 91 unopened-valve 92 (logxor unopened-valves unopened-valve-bid) 93 remaining-minutes-new))))) 94 95 (defun get-max-pressure (valve-map current-valve unopened-valves remaining-minutes) 96 (let* ((key (list (bid current-valve) 97 unopened-valves 98 remaining-minutes)) 99 (cached (gethash key *pressure-cache*))) 100 (when cached 101 (return-from get-max-pressure cached)) 102 (let ((max-pressure (calculate-max-pressure valve-map 103 current-valve 104 unopened-valves 105 remaining-minutes))) 106 (when *pressure-cache* 107 (setf (gethash key *pressure-cache*) max-pressure)) 108 max-pressure))) 109 110 (defun map-human-elephant-valves (func valves) 111 (loop with valve-bids = (get-active-bits valves) 112 for i from 0 to (length valve-bids) 113 do (map-combinations 114 (lambda (combination) 115 (let ((elephant (remove-if 116 (lambda (bid) 117 (member bid combination)) 118 valve-bids))) 119 (funcall func 120 (reduce #'logior combination) 121 (reduce #'logior elephant)))) 122 valve-bids 123 :length i))) 124 125 (defun task1 (inputs) 126 (let ((*distance-cache* (make-hash-table :test 'equal)) 127 (*pressure-cache* (make-hash-table :test 'equal))) 128 (multiple-value-bind (start valve-map unopened-valves) 129 (make-graph inputs) 130 (get-max-pressure valve-map 131 start 132 unopened-valves 133 30)))) 134 135 (defun task2 (inputs) 136 (let ((*distance-cache* (make-hash-table :test 'equal)) 137 (*pressure-cache* (make-hash-table :test 'equal)) 138 (max-pressure 0)) 139 (multiple-value-bind (start valve-map unopened-valves) 140 (make-graph inputs) 141 (map-human-elephant-valves 142 (lambda (human elephant) 143 (setf max-pressure 144 (max max-pressure 145 (+ (get-max-pressure valve-map 146 start 147 human 148 26) 149 (get-max-pressure valve-map 150 start 151 elephant 152 26))))) 153 unopened-valves)) 154 max-pressure)) 155 156 (defun parse-line (input) 157 (register-groups-bind (valve rate next-valves) 158 (+input-line-regex+ input) 159 (list (intern valve :keyword) 160 (parse-integer rate) 161 (mapcar (lambda (valve) 162 (intern valve :keyword)) 163 (str:split ", " next-valves))))) 164 165 (define-day 16 166 (:translate-input #'parse-line) 167 #'task1 168 #'task2)