track current flow in place not on sorting. Speedup

1 files changed, 23 insertions, 13 deletions

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 0d2d9d7..f7c35b6 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -50,12 +50,12 @@
         sum (1+ distance) into runtime
         collect runtime))
 
-(defun next-options (current graph open time-left)
+(defun next-options (current-options open time-left)
   (flet ((appropriate (next)
            (destructuring-bind (next-node-name . time-there) next
              (and (not (member next-node-name open :test #'eq))
                   (< (1+ time-there) time-left)))))
-    (remove-if-not #'appropriate (cdr (gethash current graph)))))
+    (remove-if-not #'appropriate (cdr current-options))))
 
 (defun path-release-as (path graph start-time)
   (loop for (from to) on path
@@ -87,7 +87,6 @@
    (= 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))))
-(fiveam:run-all-tests)
 ;;
 ;; part 1
 (let* ((open '(aa))
@@ -98,7 +97,7 @@
   ;; (loop for k being the hash-keys in open using (hash-value v)
   ;;       do (format t "~a=>~a~%" k v))
   (labels ((traverse (graph node open time-left current-flow)
-             (let ((next (next-options node graph open time-left)))
+             (let ((next (next-options (gethash node graph) open time-left)))
                (if (null next)
                    (reverse open)
                    (arrows:->
@@ -138,24 +137,27 @@
 (defun part2 (filename)
   (let* ((action-graph (worthwhile-graph (data filename)))
          (start-time 26)
-         (actor (list `((aa) ,start-time) `((aa) ,start-time))))
+         (actor (list `((aa) ,start-time 0) `((aa) ,start-time 0))))
 
     ;; (loop for k being the hash-keys in open using (hash-value v)
     ;;       do (format t "~a=>~a~%" k v))
     (labels ((traverse (graph actor open)
                (if (loop for ac in actor
                          :always (zerop (cadr ac)))
-                   (mapcar (lambda (a) (reverse (car a))) actor)
-                   (destructuring-bind (path time-left) (car actor)
+                   (mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor)
+                   (destructuring-bind (path time-left previous-flow) (car actor)
                      ;; (princ (car actor))
                      ;; (princ (path-release2 (reverse open) graph start-time))
                      ;; (princ (recover-paths (reverse open)))
                      ;; (terpri)
-                     (let ((next (next-options (car path) graph open time-left)))
+                     (let* ((current-options (gethash (car path) graph))
+                            (flow-released (car current-options))
+                            (current-flow (+ previous-flow (* flow-released time-left)))
+                            (next (next-options current-options open time-left)))
                        (if (null next)
                            (traverse graph
                                      (append (cdr actor)
-                                             (list (list path 0)))
+                                             (list (list path 0 current-flow)))
                                      open)
 
                            (arrows:->
@@ -163,19 +165,27 @@
                               (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)))
+                                            (append (cdr actor) (list (list (cons name path) time-left
+                                                                            current-flow)))
                                             (cons name open)))))
 
                             (mapcar next)
                             (sort #'>= :key (lambda (actor-paths)
-                                              (path-release2 actor-paths graph start-time)))
+                                              ;; (path-release2 actor-paths graph start-time)
+                                              (reduce #'+ actor-paths :key #'caddr)
+                                              ))
                             (car))))))))
       ;; (princ)
       (traverse action-graph actor '(aa)))))
 
-(part2 "eg-in")
+(fiveam:test solution2
+  (fiveam:is
+   (= 1707 (reduce #'+ (solver "eg-in" 26 2) :key #'caddr)))
+  (fiveam:is
+   (= 2474 (reduce #'+ (part2 "input") :key #'caddr)))
+  )
 
-(part2 "input")
+(fiveam:run-all-tests)
 ;; (require :sb-sprof)
 
 ;; (sb-sprof:with-profiling (:max-samples 1000