aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2022-12-19 18:00:41 +0100
committerOscar Najera <hi@oscarnajera.com>2022-12-19 18:27:22 +0100
commitf7037e40585d74f2ed1812f52d9b8fed37172b01 (patch)
treee2d37915677933d6970d2188e557c38d3b3fded4
parent228e1322dd5e678ee041143eb8a27c3d5933f0d8 (diff)
downloadscratch-f7037e40585d74f2ed1812f52d9b8fed37172b01.tar.gz
scratch-f7037e40585d74f2ed1812f52d9b8fed37172b01.tar.bz2
scratch-f7037e40585d74f2ed1812f52d9b8fed37172b01.zip
order
-rw-r--r--AoC2022/16/solver.lisp79
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