aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--AoC2022/16/solver.lisp70
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