diff options
| -rw-r--r-- | AoC2022/16/solver.lisp | 44 |
1 files changed, 21 insertions, 23 deletions
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp index bdd8fc3..0b3e309 100644 --- a/AoC2022/16/solver.lisp +++ b/AoC2022/16/solver.lisp @@ -1,4 +1,3 @@ - (ql:quickload '(fiveam cl-ppcre uiop arrows)) (defun data (filename) @@ -31,16 +30,14 @@ (gethash to paths))) (defun worthwhile-graph (graph) - (let ((interesting (remove-if #'zerop graph :key #'cadr)) - (htgraph (make-hash-table :test #'eq :size 16))) + (let ((interesting (remove-if #'zerop graph :key #'cadr))) (loop for (from flow) in (cons '(aa 0) interesting) - do - (setf (gethash from htgraph) - (cons flow + for label from 0 + collect (apply #'list (ash 1 label) from flow (loop for (to) in interesting + for target-label from 1 when (not (eq from to)) - collect (cons to (1- (length (shortest-path graph from to)))))))) - htgraph)) + collect (cons (ash 1 target-label) (1- (length (shortest-path graph from to))))))))) (defun travel-time (path graph) (loop for (from to) on path @@ -53,9 +50,9 @@ (defun next-options (current-options open time-left) (flet ((appropriate (next) (destructuring-bind (next-node-name . time-there) next - (and (not (member next-node-name open :test #'eq)) + (and (zerop (logand next-node-name open)) (< (1+ time-there) time-left))))) - (remove-if-not #'appropriate (cdr current-options)))) + (remove-if-not #'appropriate (cdddr current-options)))) (defun path-release-as (path graph start-time) (loop for (from to) on path @@ -69,17 +66,18 @@ (defun path-release (path graph start-time) (loop for (from to) on path - for node-from = (gethash from graph) then node-to - and node-to = (gethash to graph) + for node-from = (rassoc from graph :key #'car) then node-to + and node-to = (rassoc to graph :key #'car) while node-to - for neighbors = (cdr node-from) - for flow = (car node-to) - for distance = (cdr (assoc to neighbors :test #'eq)) + for neighbors = (cdddr node-from) + for flow = (caddr node-to) + for distance = (cdr (assoc (car node-to) neighbors :test #'eq)) sum (1+ distance) into runtime sum (* flow (- start-time runtime)) into release finally (return release))) ;; (shortest-path (data "eg-in") 'AA 'CC) + (fiveam:test loads (fiveam:is (= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in")) 30))) @@ -111,7 +109,7 @@ (defun solver (filename start-time actors) (let* ((action-graph (worthwhile-graph (data filename))) - (actor (loop repeat actors collect `((aa) ,start-time 0)))) + (actor (loop repeat actors collect `((1) ,start-time 0)))) (labels ((traverse (graph actor open) (if (loop for ac in actor :always (zerop (cadr ac))) @@ -121,8 +119,8 @@ ;; (princ (path-release2 (reverse open) graph start-time)) ;; (princ (recover-paths (reverse open))) ;; (terpri) - (let* ((current-options (gethash (car path) graph)) - (flow-released (car current-options)) + (let* ((current-options (assoc (car path) graph :test #'=)) + (flow-released (caddr current-options)) (current-flow (+ previous-flow (* flow-released time-left))) (next (next-options current-options open time-left))) (if (null next) @@ -138,13 +136,13 @@ (traverse graph (append (cdr actor) (list (list (cons name path) time-left current-flow))) - (cons name open))))) + (logior name open))))) (mapcar next) (sort #'>= :key #'accumulated-flow) (car)))))))) ;; (princ) - (traverse action-graph actor '(aa))))) + (traverse action-graph actor 1)))) (fiveam:test solutions (fiveam:is @@ -164,9 +162,9 @@ ;; :loop t ;; :show-progress t) ;; (dotimes (_ 100) -;; (part2 "eg-in")) -;; ) -;; (time (part2 "eg-in")) +;; (solver "eg-in" 30 1))) + +;; (time (solver "eg-in" 30 1)) ;; (length (worthwhile-graph (data "input"))) ;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input")) |