diff options
| -rw-r--r-- | AoC2022/16/solver.lisp | 70 |
1 files changed, 34 insertions, 36 deletions
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp index 43cb8d7..9d07505 100644 --- a/AoC2022/16/solver.lisp +++ b/AoC2022/16/solver.lisp @@ -47,11 +47,6 @@ sum (1+ distance) into runtime collect runtime)) -(defun appropriate (node open time-left) - (destructuring-bind (next-node-name . time-there) node - (and (zerop (logand next-node-name open)) - (< (1+ time-there) time-left)))) - (defun path-release-as (path graph start-time) (loop for (from to) on path while to @@ -105,41 +100,44 @@ (defun accumulated-flow (actor-paths) (reduce #'+ actor-paths :key #'caddr)) +(defun appropriate (node open time-left) + (destructuring-bind (next-node-name . time-there) node + (and (zerop (logand next-node-name open)) + (< (1+ time-there) time-left)))) + + +(defun traverse (graph actor open) + (if (loop for ac in actor + :always (zerop (cadr ac))) + (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor) + (destructuring-bind (path time-left previous-flow) (car actor) + (let* ((current-options (assoc (car path) graph :test #'=)) + (flow-released (caddr current-options)) + (current-flow (+ previous-flow (* flow-released time-left))) + (next (remove-if-not (lambda (node) + (appropriate node open time-left)) + (cdddr current-options)))) + (if (null next) + (traverse graph + (append (cdr actor) + (list (list path 0 current-flow))) + open) + + (arrows:-> + (loop for (name . time-there) in next + collect + (let ((time-left (- time-left time-there 1))) + (traverse graph + (append (cdr actor) (list (list (cons name path) time-left + current-flow))) + (logior name open)))) + (sort #'>= :key #'accumulated-flow) + (car))))))) (defun solver (filename start-time actors) (let* ((action-graph (worthwhile-graph (data filename))) (actor (loop repeat actors collect `((1) ,start-time 0)))) - (labels ((traverse (graph actor open) - (if (loop for ac in actor - :always (zerop (cadr ac))) - (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor) - (destructuring-bind (path time-left previous-flow) (car actor) - (let* ((current-options (assoc (car path) graph :test #'=)) - (flow-released (caddr current-options)) - (current-flow (+ previous-flow (* flow-released time-left))) - (next (remove-if-not (lambda (node) - (appropriate node open time-left)) - (cdddr current-options)))) - (if (null next) - (traverse graph - (append (cdr actor) - (list (list path 0 current-flow))) - open) - - (arrows:-> - (lambda (next-node) - (destructuring-bind (name . time-there) next-node - (let ((time-left (- time-left time-there 1))) - (traverse graph - (append (cdr actor) (list (list (cons name path) time-left - current-flow))) - (logior name open))))) - - (mapcar next) - (sort #'>= :key #'accumulated-flow) - (car)))))))) - ;; (princ) - (traverse action-graph actor 1)))) + (traverse action-graph actor 1))) (fiveam:test solutions (fiveam:is |