some cleanups

1 files changed, 61 insertions, 50 deletions

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 66fb622..0366fc3 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -53,7 +53,7 @@
                   (< (1+ time-there) time-left)))))
     (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))
 
-(defun path-release (path graph start-time)
+(defun path-release-as (path graph start-time)
   (loop for (from to) on path
         while to
         for neighbors = (cddr (assoc from graph :test #'eq))
@@ -63,12 +63,24 @@
         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 = (assoc from graph :test #'eq) then node-to
+        and node-to   = (assoc to graph :test #'eq)
+        while node-to
+        for neighbors = (cddr node-from)
+        for flow = (cadr 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)))
+
 (shortest-path (data "eg-in") 'AA 'CC)
 
 (= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in")) 30))
 (= 1651 (path-release '(AA DD BB JJ HH EE CC) (worthwhile-graph (data "eg-in")) 30))
 (= 560 (path-release '(AA DD) (worthwhile-graph (data "eg-in")) 30))
-
+;;
 ;; part 1
 (let* ((open '(aa))
        (action-graph (worthwhile-graph (data "input")))
@@ -97,14 +109,6 @@
 
 ;; part 2
 
-(loop for a in '(a b c d e) by #'cddr
-      collect a)
-
-(defun recover-paths (path)
-  (list
-   (cons (car path)  (loop for me in (cdr path) by #'cddr collect me))
-   (cons (car path) (loop for el in (cddr path) by #'cddr collect el))))
-
 (defun path-release2 (paths graph start-time)
   (reduce #'+ paths
           :key (lambda (path) (path-release path graph start-time))))
@@ -115,9 +119,6 @@
 (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 (recover-paths '(AA JJ DD BB HH CC EE)) (worthwhile-graph (data "eg-in")) 26)
-(path-release2 (recover-paths '(AA JJ DD BB EE CC HH)) (worthwhile-graph (data "eg-in")) 26)
-(path-release2 (recover-paths '(AA JJ DD BB EE CC HH)) (worthwhile-graph (data "eg-in")) 26)
 (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
@@ -126,44 +127,54 @@
 ;;     '(AA RA XK YH NM YP XS)
 ;;  (worthwhile-graph (data "input")))
 
-(let* ((action-graph (worthwhile-graph (data "input")))
-       (start-time 26)
-       (actor (list `((aa) ,start-time) `((aa) ,start-time))))
-  ;; (path-release)
-
-  ;; (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)
-                   ;; (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)))
-                     (if (null next)
-                         (traverse graph
-                                   (append (cdr actor)
-                                           (list (list path 0)))
-                                   open)
-
-                         (arrows:->
-                          (lambda (next-node)
-                            (destructuring-bind (name . time-there) next-node
-                              (let (;;(flow (cadr (assoc name graph :test #'eq)))
-                                    (time-left (- time-left time-there 1)))
-                                (traverse graph
-                                          (append (cdr actor) (list (list (cons name path) time-left)))
-                                          (cons name open)))))
-
-                          (mapcar next)
-                          (sort #'>= :key (lambda (actor-paths)
-                                            (path-release2 actor-paths graph start-time)))
-                          (car))))))))
-    (princ (traverse action-graph actor '(aa)))))
+(defun part2 ()
+  (let* ((action-graph (worthwhile-graph (data "eg-in")))
+         (start-time 26)
+         (actor (list `((aa) ,start-time) `((aa) ,start-time))))
 
+    ;; (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)
+                     ;; (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)))
+                       (if (null next)
+                           (traverse graph
+                                     (append (cdr actor)
+                                             (list (list path 0)))
+                                     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)))
+                                            (cons name open)))))
+
+                            (mapcar next)
+                            (sort #'>= :key (lambda (actor-paths)
+                                              (path-release2 actor-paths graph start-time)))
+                            (car))))))))
+      ;; (princ)
+      (traverse action-graph actor '(aa)))))
+
+(require :sb-sprof)
+
+(sb-sprof:with-profiling (:max-samples 1000
+                          :report :flat
+                          :loop t
+                          :show-progress t)
+  (dotimes (_ 100)
+    (part2))
+  )
+(time (part2))
 ;; (length (worthwhile-graph (data "input")))
 
 ;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input"))