diff options
| -rw-r--r-- | AoC2022/16/solver.lisp | 79 |
1 files changed, 41 insertions, 38 deletions
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp index d8cb718..9f9ac68 100644 --- a/AoC2022/16/solver.lisp +++ b/AoC2022/16/solver.lisp @@ -120,47 +120,50 @@ (max-possible-flow graph (list (list path 26 0)) 111)) ) -(defun traverse (graph actors open best-flow) - (destructuring-bind (current-actor . others) actors - (destructuring-bind (path time-left previous-flow) current-actor - (if (or (loop for ac in actors :always (zerop (cadr ac))) - (< (max-possible-flow graph actors open) (accumulated-flow best-flow))) - (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actors) - (let* ((current-options (assoc (car path) graph :test #'=)) - (travel-times (cdddr current-options)) - (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) - (let* ((flow-there (caddr (assoc node graph :test #'=))) - (next-flow (+ previous-flow (* flow-there time-left)))) - - (cons node (list (list (cons node path) time-left next-flow))))))) - :collect it))) - (if (null next) - (traverse graph - (append others - (list (list path 0 previous-flow))) - open best-flow) - (reduce - (lambda (acc term) - (let* ((acc-flow (accumulated-flow acc)) - (next-actors - (destructuring-bind (node . actors-next-move) term - (traverse graph - (append (cdr actors) actors-next-move) - (logior node open) - acc)))) - (if (> acc-flow (accumulated-flow next-actors)) - acc next-actors))) - next - :initial-value best-flow))))))) +(defun traverse (graph actors open best-flow all-valves) + (if (or (zerop (logxor open all-valves)) + (zerop (cadar actors)) + (< (max-possible-flow graph actors open) (accumulated-flow best-flow))) + (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actors) + (destructuring-bind (current-actor . others) actors + (destructuring-bind (path time-left previous-flow) current-actor + (destructuring-bind (current-node _label _flow . travel-times) + (assoc (car path) graph :test #'=) + (let ((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) + (let* ((flow-there (caddr (assoc node graph :test #'=))) + (next-flow (+ previous-flow (* flow-there time-left)))) + (cons node (list (list (cons node path) time-left next-flow))))))) + :collect it))) + (if (null next) + (progn + ;; (format t "hit open ~a actors: ~a~%" open actors) + (traverse graph + (append others + (list (list path 0 previous-flow))) + open best-flow all-valves)) + (reduce + (lambda (acc term) + (let* ((acc-flow (accumulated-flow acc)) + (next-actors + (destructuring-bind (node . actors-next-move) term + (traverse graph + (append (cdr actors) actors-next-move) + (logior node open) + acc all-valves)))) + (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 nil))) + (actor (loop repeat actors collect `((1) ,start-time 0))) + (all-valves (loop for (idx) in action-graph sum idx))) + (traverse action-graph actor 1 nil all-valves))) (fiveam:test solutions (fiveam:is |