reorder cleanup

1 files changed, 105 insertions, 104 deletions

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 9f9ac68..f3ecf5d 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -25,8 +25,6 @@
                    (unless (member to next :test #'eq)
                      (traverse (append (cdr queue) next) paths))))))
       (traverse (list from) paths))
-    ;; (loop for k being the hash-keys in paths using (hash-value v)
-    ;;       do (format t "~a=>~a~%" k v))
     (gethash to paths)))
 
 (defun worthwhile-graph (graph)
@@ -39,68 +37,6 @@
                                when (not (eq from to))
                                  collect (cons (ash 1 target-label) (1- (length (shortest-path graph from to)))))))))
 
-(defun travel-time (path graph)
-  (loop for (from to) on path
-        while to
-        for neighbors = (cdddr (assoc from graph :test #'eq))
-        for distance = (cdr (assoc to neighbors :test #'eq))
-        sum (1+ distance) into runtime
-        collect runtime))
-
-(defun path-release-as (path graph start-time)
-  (loop for (from to) on path
-        while to
-        for neighbors = (cddr (assoc from graph :test #'eq))
-        for flow = (cadr (assoc to graph :test #'eq))
-        for distance = (cdr (assoc to neighbors :test #'eq))
-        sum (1+ distance) into runtime
-        sum (* flow (- start-time runtime)) into release
-        finally (return release)))
-
-(defun path-release (path graph start-time)
-  (loop for (from to) on path
-        for node-from = (rassoc from graph :key #'car) then node-to
-        and node-to   = (rassoc to graph :key #'car)
-        while node-to
-        for neighbors = (cdddr node-from)
-        for flow = (caddr node-to)
-        for distance = (cdr (assoc (car node-to) neighbors :test #'eq))
-        sum (1+ distance) into runtime
-        sum (* flow (- start-time runtime)) into release
-        finally (return release)))
-
-;; (shortest-path (data "eg-in") 'AA 'CC)
-
-(fiveam:test loads
-  (fiveam:is
-   (= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in")) 30)))
-  (fiveam:is
-   (= 1651 (path-release '(AA DD BB JJ HH EE CC) (worthwhile-graph (data "eg-in")) 30)))
-  (fiveam:is
-   (= 560 (path-release '(AA DD) (worthwhile-graph (data "eg-in")) 30))))
-
-(defun path-release2 (paths graph start-time)
-  (reduce #'+ paths
-          :key (lambda (path) (path-release path graph start-time))))
-
-(defun path-to-symbols (path graph)
-  (loop for node in path
-        collect (cadr (assoc node graph :test #'=))))
-
-
-(path-release '(AA DD) (worthwhile-graph (data "eg-in")) 26)
-(path-release '(AA DD EE) (worthwhile-graph (data "eg-in")) 26)
-(path-release '(AA DD HH EE) (worthwhile-graph (data "eg-in")) 12)
-(path-release '(AA DD EE HH) (worthwhile-graph (data "eg-in")) 12)
-
-(path-release2 '((AA NU WK NC ZG EA CX QC) (AA RA XK YH NM YP XS)) (worthwhile-graph (data "input")) 26)
-(path-release2 '((AA NU WK NC ZG EA CX QC) (AA XK YH NM YP XS)) (worthwhile-graph (data "input")) 26)
-;; (travel-time
-;;  ;; '(AA NU WK NC ZG XK YH NM YP)
-;;  ;; '(AA NU WK NC ZG EA CX QC)
-;;     '(AA RA XK YH NM YP XS)
-;;  (worthwhile-graph (data "input")))
-
 (defun accumulated-flow (actor-paths)
   (reduce #'+ actor-paths :key #'caddr))
 
@@ -111,15 +47,6 @@
              :when (not (logtest node open))
              :sum (* flow actors-min-time-left)))))
 
-(let* ((graph (worthwhile-graph (data "eg-in")))
-       (path '(1 64 8 32 2 16 4))
-       (sym-path (path-to-symbols path graph)))
-  (list
-   (path-release sym-path graph 30)
-   (travel-time path graph)
-   (max-possible-flow graph (list (list path 26 0)) 111))
-  )
-
 (defun traverse (graph actors open best-flow all-valves)
   (if (or (zerop (logxor open all-valves))
           (zerop (cadar actors))
@@ -127,37 +54,37 @@
       (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))))))))
+          (let ((next
+                  (loop for (next-node . time-there) in (cdddr (assoc (car path) graph :test #'=))
+                        :when (and (not (logtest next-node open))
+                                   (let ((time-left (- time-left time-there 1)))
+                                     (when (plusp time-left)
+                                       (let* ((flow-there (caddr (assoc next-node graph :test #'=)))
+                                              (next-flow (+ previous-flow (* flow-there time-left))))
+                                         (cons next-node (list (list (cons next-node path) time-left next-flow)))))))
+                          :collect it)))
+            (if (null next)
+                  ;; for performance reasons I don't understand separating this
+                  ;; no-op option to move to next actor is faster that preparing
+                  ;; the identity move within next before
+                  ;; (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))
+                          (new-flow
+                            (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 new-flow))
+                         acc new-flow)))
+                 next
+                 :initial-value best-flow)))))))
 
 (defun solver (filename start-time actors)
   (let* ((action-graph (worthwhile-graph (data filename)))
@@ -165,6 +92,80 @@
          (all-valves (loop for (idx) in action-graph sum idx)))
     (traverse action-graph actor 1 nil all-valves)))
 
+;; Auxiliary functions for inspection
+(defun path->symbols (path graph)
+  (loop for node in path
+        collect (cadr (assoc node graph :test #'=))))
+
+(defun path<-symbols (path graph)
+  (loop for node in path
+        collect (car (rassoc node graph :key #'car :test #'eq))))
+
+(defun travel-time (path graph)
+  (if (every #'symbolp path)
+      (travel-time (path<-symbols path graph) graph)
+      (loop for (from to) on path
+            while to
+            for neighbors = (cdddr (assoc from graph :test #'eq))
+            for distance = (cdr (assoc to neighbors :test #'eq))
+            sum (1+ distance) into runtime
+            collect runtime)))
+
+(defun path-release (path graph start-time)
+  (if (every #'symbolp path)
+      (path-release (path<-symbols path graph) graph start-time)
+      (loop for (from to) on path
+            for node-from = (assoc from graph) then node-to
+            and node-to   = (assoc to graph)
+            while node-to
+            for neighbors = (cdddr node-from)
+            for flow = (caddr node-to)
+            for distance = (cdr (assoc to neighbors :test #'eq))
+            sum (1+ distance) into runtime
+            sum (* flow (- start-time runtime)) into release
+            finally (return release))))
+
+(defun many-path-release (paths graph start-time)
+  (reduce #'+ paths
+          :key (lambda (path) (path-release path graph start-time))))
+
+(fiveam:test paths
+  (let ((graph-eg (worthwhile-graph (data "eg-in")))
+        (test-path '(1 8 32)))
+    (arrows:->
+     (path->symbols test-path graph-eg)
+     (path<-symbols graph-eg)
+     (equal test-path)
+     (fiveam:is))
+    (fiveam:is (equal (travel-time '(AA CC DD JJ) graph-eg) '(3 5 9)))
+
+    (fiveam:is
+     (= 1648 (path-release '(AA DD JJ BB CC HH EE) graph-eg 30)))
+    (fiveam:is
+     (= 1651 (path-release '(AA DD BB JJ HH EE CC) graph-eg 30)))
+    (fiveam:is (= 480 (path-release '(AA DD) graph-eg 26)))
+    (fiveam:is (= 560 (path-release '(AA DD) graph-eg 30)))
+    (fiveam:is (= 546 (path-release '(AA DD EE) graph-eg 26)))
+    (fiveam:is (= 313 (path-release '(AA DD HH EE) graph-eg 12)))
+    (fiveam:is (= 312 (path-release '(AA DD EE HH) graph-eg 12))))
+  (let ((graph-input (worthwhile-graph (data "input"))))
+    (fiveam:is (= 2473 (many-path-release '((AA NU WK NC ZG EA CX QC) (AA RA XK YH NM YP XS)) graph-input 26)))
+    (fiveam:is (= 2474 (many-path-release '((AA NU WK NC ZG EA CX QC) (AA XK YH NM YP XS)) graph-input 26)))))
+
+(fiveam:test partial-sections
+  (let* ((graph (worthwhile-graph (data "eg-in")))
+         (path '(1 64 8 32 2 16 4)))
+    (fiveam:is (= 1595 (path-release path graph 30)))
+    (fiveam:is (equal '(3 7 12 19 23 26) (travel-time path graph)))
+    (fiveam:is (= 78 (max-possible-flow graph (list (list path 26 0)) 111))))
+
+  (let* ((graph (worthwhile-graph (data "input")))
+         (path '(1 1024 32768 128 8192 2 2048 64 4096)))
+    (list
+     (fiveam:is (= 1754 (path-release path graph 30)))
+     (fiveam:is (equal '(3 6 9 12 19 22 25 28) (travel-time path graph)))
+     (fiveam:is (= 3588 (max-possible-flow graph (list (list path 26 0)) 111))))))
+
 (fiveam:test solutions
   (fiveam:is
    (= 1651 (accumulated-flow (solver "eg-in" 30 1))))