From 7a756c8ef8d4afc134430752580f89e893baf2d6 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Mon, 19 Dec 2022 04:51:49 +0100
Subject: isolate and denest

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

(limited to 'AoC2022')

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