aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2022-12-19 14:43:01 +0100
committerOscar Najera <hi@oscarnajera.com>2022-12-19 14:43:01 +0100
commitf7551e820f2ba9852adce11be59946a48df83d66 (patch)
treee03f0cded4e63fac2e5d9ee9cbeb0fa936fad174 /AoC2022
parent067c433611309f4e752f2862b04f91b112b3b287 (diff)
downloadscratch-f7551e820f2ba9852adce11be59946a48df83d66.tar.gz
scratch-f7551e820f2ba9852adce11be59946a48df83d66.tar.bz2
scratch-f7551e820f2ba9852adce11be59946a48df83d66.zip
compact
Diffstat (limited to 'AoC2022')
-rw-r--r--AoC2022/16/solver.lisp70
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