Logical path test instead of member

1 files changed, 21 insertions, 23 deletions

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index bdd8fc3..0b3e309 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -1,4 +1,3 @@
-
 (ql:quickload '(fiveam cl-ppcre uiop arrows))
 
 (defun data (filename)
@@ -31,16 +30,14 @@
     (gethash to paths)))
 
 (defun worthwhile-graph (graph)
-  (let ((interesting (remove-if #'zerop graph :key #'cadr))
-        (htgraph (make-hash-table :test #'eq :size 16)))
+  (let ((interesting (remove-if #'zerop graph :key #'cadr)))
     (loop for (from flow) in (cons '(aa 0) interesting)
-          do
-             (setf (gethash from htgraph)
-                   (cons flow
+          for label from 0
+          collect (apply #'list (ash 1 label) from flow
                          (loop for (to) in interesting
+                               for target-label from 1
                                when (not (eq from to))
-                                 collect (cons to (1- (length (shortest-path graph from to))))))))
-    htgraph))
+                                 collect (cons (ash 1 target-label) (1- (length (shortest-path graph from to)))))))))
 
 (defun travel-time (path graph)
   (loop for (from to) on path
@@ -53,9 +50,9 @@
 (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))
+             (and (zerop (logand next-node-name open))
                   (< (1+ time-there) time-left)))))
-    (remove-if-not #'appropriate (cdr current-options))))
+    (remove-if-not #'appropriate (cdddr current-options))))
 
 (defun path-release-as (path graph start-time)
   (loop for (from to) on path
@@ -69,17 +66,18 @@
 
 (defun path-release (path graph start-time)
   (loop for (from to) on path
-        for node-from = (gethash from graph) then node-to
-        and node-to   = (gethash to graph)
+        for node-from = (rassoc from graph :key #'car) then node-to
+        and node-to   = (rassoc to graph :key #'car)
         while node-to
-        for neighbors = (cdr node-from)
-        for flow = (car node-to)
-        for distance = (cdr (assoc to neighbors :test #'eq))
+        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)))
@@ -111,7 +109,7 @@
 
 (defun solver (filename start-time actors)
   (let* ((action-graph (worthwhile-graph (data filename)))
-         (actor (loop repeat actors collect `((aa) ,start-time 0))))
+         (actor (loop repeat actors collect `((1) ,start-time 0))))
     (labels ((traverse (graph actor open)
                (if (loop for ac in actor
                          :always (zerop (cadr ac)))
@@ -121,8 +119,8 @@
                      ;; (princ (path-release2 (reverse open) graph start-time))
                      ;; (princ (recover-paths (reverse open)))
                      ;; (terpri)
-                     (let* ((current-options (gethash (car path) graph))
-                            (flow-released (car current-options))
+                     (let* ((current-options (assoc (car path) graph :test #'=))
+                            (flow-released (caddr current-options))
                             (current-flow (+ previous-flow (* flow-released time-left)))
                             (next (next-options current-options open time-left)))
                        (if (null next)
@@ -138,13 +136,13 @@
                                   (traverse graph
                                             (append (cdr actor) (list (list (cons name path) time-left
                                                                             current-flow)))
-                                            (cons name open)))))
+                                            (logior name open)))))
 
                             (mapcar next)
                             (sort #'>= :key #'accumulated-flow)
                             (car))))))))
       ;; (princ)
-      (traverse action-graph actor '(aa)))))
+      (traverse action-graph actor 1))))
 
 (fiveam:test solutions
   (fiveam:is
@@ -164,9 +162,9 @@
 ;;                           :loop t
 ;;                           :show-progress t)
 ;;   (dotimes (_ 100)
-;;     (part2 "eg-in"))
-;;   )
-;; (time (part2 "eg-in"))
+;;     (solver "eg-in" 30 1)))
+
+;; (time (solver "eg-in" 30 1))
 ;; (length (worthwhile-graph (data "input")))
 
 ;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input"))