order

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