diff options
| -rw-r--r-- | AoC2022/16/solver.lisp | 70 |
1 files changed, 32 insertions, 38 deletions
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp index e2addaf..e1dff91 100644 --- a/AoC2022/16/solver.lisp +++ b/AoC2022/16/solver.lisp @@ -100,51 +100,45 @@ (defun accumulated-flow (actor-paths) (reduce #'+ actor-paths :key #'caddr)) -(defun traverse (graph actor open) +(defun traverse (graph actor open best-flow) (if (loop for ac in actor :always (zerop (cadr ac))) (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor) - (advance graph actor open))) - -;; (let ((graph (worthwhile-graph (data "eg-in")))) - -;; ) - -(defun advance (graph actor open) - (destructuring-bind (path time-left previous-flow) (car actor) - (let* ((current-options (assoc (car path) graph :test #'=)) - (travel-times (cdddr current-options)) - (flow-released (caddr current-options)) - (current-flow (+ previous-flow (* flow-released time-left))) - (next - (loop for (node . time-there) in travel-times - :when (and (not (logtest node open)) - (let ((time-left (- time-left time-there 1))) - (when (plusp time-left) - (cons node (list (list (cons node path) time-left current-flow)))))) - :collect it))) - (if (null next) - (traverse graph - (append (cdr actor) - (list (list path 0 current-flow))) - open) - (reduce - (lambda (acc term) - (let ((acc-flow (accumulated-flow acc)) - (next-actors - (destructuring-bind (node . actor-next-move) term - (traverse graph - (append (cdr actor) actor-next-move) - (logior node open))))) - (if (>= acc-flow (accumulated-flow next-actors)) - acc next-actors))) - - next :initial-value nil))))) + (destructuring-bind (path time-left previous-flow) (car actor) + (let* ((current-options (assoc (car path) graph :test #'=)) + (travel-times (cdddr current-options)) + (flow-released (caddr current-options)) + (current-flow (+ previous-flow (* flow-released time-left))) + (next + (loop for (node . time-there) in travel-times + :when (and (not (logtest node open)) + (let ((time-left (- time-left time-there 1))) + (when (plusp time-left) + (cons node (list (list (cons node path) time-left current-flow)))))) + :collect it))) + (if (null next) + (traverse graph + (append (cdr actor) + (list (list path 0 current-flow))) + open best-flow) + (reduce + (lambda (acc term) + (let* ((acc-flow (accumulated-flow acc)) + (next-actors + (destructuring-bind (node . actor-next-move) term + (traverse graph + (append (cdr actor) actor-next-move) + (logior node open) + acc)))) + (if (>= acc-flow (accumulated-flow next-actors)) + acc next-actors))) + + next :initial-value best-flow)))))) (defun solver (filename start-time actors) (let* ((action-graph (worthwhile-graph (data filename))) (actor (loop repeat actors collect `((1) ,start-time 0)))) - (traverse action-graph actor 1))) + (traverse action-graph actor 1 nil))) (fiveam:test solutions (fiveam:is |