From f5b089d6a1b1af5c164c3fa564af3b37f6d03f2e Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 18 Dec 2022 15:42:35 +0100
Subject: Return optimal path too

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

(limited to 'AoC2022')

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 5eddea1..1e161cf 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -38,12 +38,6 @@
     ;;       do (format t "~a=>~a~%" k v))
     (gethash to paths)))
 
-(defun path-release (paths)
-  (loop for (name flow distance) in paths
-        sum (1+ distance) into runtime
-        sum (* flow (- 30 runtime)) into release
-        finally (return release)))
-
 (= 340 (path-release '((a 5 1) (b 8 2))))
 (shortest-path (data "eg-in") 'AA 'CC)
 
@@ -66,6 +60,20 @@
                   (< (1+ time-there) time-left)))))
     (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))
 
+(defun path-release (path graph)
+  (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 (- 30 runtime)) into release
+        finally (return release)))
+
+(= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in"))))
+(= 1651 (path-release '(AA DD BB JJ HH EE CC) (worthwhile-graph (data "eg-in"))))
+(= 560 (path-release '(AA DD) (worthwhile-graph (data "eg-in"))))
+
 (let* ((open '(aa))
        (action-graph (worthwhile-graph (data "input"))))
   ;; (path-release)
@@ -75,8 +83,9 @@
   (labels ((traverse (graph node open time-left current-flow)
              (let ((next (next-options node graph open time-left)))
                (if (null next)
-                   current-flow
-                   (arrows:-<>
+                   (let ((res (reverse open)))
+                     (list (path-release res graph) res))
+                   (arrows:->
                     (lambda (next-node)
                       (destructuring-bind (name . time-there) next-node
                         (let ((flow (cadr (assoc name graph :test #'eq)))
@@ -85,12 +94,7 @@
                                     time-left
                                     (+ current-flow
                                        (* flow time-left))))))
-                    (mapcar <> next)
-                    (reduce #'max <>))))))
-    (traverse action-graph 'aa open 30 0)
-    )
-
-
-
-
-  )
+                    (mapcar next)
+                    (sort #'>= :key #'car)
+                    (car))))))
+    (apply #'values (traverse action-graph 'aa open 30 0))))
-- 
cgit v1.2.3