From f7551e820f2ba9852adce11be59946a48df83d66 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Mon, 19 Dec 2022 14:43:01 +0100
Subject: compact

---
 AoC2022/16/solver.lisp | 70 +++++++++++++++++++++++---------------------------
 1 file changed, 32 insertions(+), 38 deletions(-)

(limited to 'AoC2022')

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
-- 
cgit v1.2.3