LISP solve part 1 day 16

1 files changed, 35 insertions, 99 deletions

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 6e4a3a1..5eddea1 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -38,10 +38,6 @@
     ;;       do (format t "~a=>~a~%" k v))
     (gethash to paths)))
 
-(defun travel-time (paths)
-  (loop for (name flow distance) in paths
-        sum (1+ distance)))
-
 (defun path-release (paths)
   (loop for (name flow distance) in paths
         sum (1+ distance) into runtime
@@ -51,22 +47,6 @@
 (= 340 (path-release '((a 5 1) (b 8 2))))
 (shortest-path (data "eg-in") 'AA 'CC)
 
-(defun close-option (interesting graph visited)
-  (sort
-   (mapcar (lambda (node)
-            (setf (gethash (car node) visited)
-                  (cons (move-to node 'aa graph) (gethash 'aa visited))) )
-           interesting)
-   #'>
-   :key (lambda (path) (path-release (reverse path)))))
-
-(defun make-edge (from to)
-  (intern
-   (concatenate 'string
-    (symbol-name from)
-    "-"
-    (symbol-name to))))
-
 (defun worthwhile-graph (graph)
   (let ((interesting (remove-if #'zerop graph :key #'cadr)))
     (loop for (from flow) in (cons '(aa 0) interesting)
@@ -75,86 +55,42 @@
                                when (not (eq from to))
                                  collect (cons to (1- (length (shortest-path graph from to)))))))))
 
-(worthwhile-graph
- (data "eg-in"))
-
-(defun next-options (current graph visited)
-  (let ((to-this-node (gethash current visited)))
-    (flet ((appropriate (next)
-             (destructuring-bind (next-node-name . time-there) next
-               (let* ((route-to-next (gethash next-node-name visited))
-                      (next-node-flow (cadr (assoc next-node-name graph :test #'eq)))
-                      (move-to-next (list next-node-name next-node-flow time-there)))
-                 (when (or (and (not route-to-next)
-                                (< (1+ time-there) (- 30 (travel-time to-this-node))))
-                           (and (not (member next-node-name to-this-node :key #'car))
-                                (< (path-release route-to-next)
-                                   (path-release (cons move-to-next to-this-node)))))
-                   (setf (gethash (car next) visited)
-                         (cons move-to-next (gethash current visited))))))))
-      (arrows:-<>
-       (mapcar #'appropriate (cddr (assoc current graph :test #'eq)))
-       (delete nil <>)
-       ;; (sort <> #'> :key (lambda (path) (path-release (reverse path))))
-       (mapcar #'caar <>)))))
-
-(let* ((graph (data "eg-in"))
-       (open (make-hash-table :test #'eq))
-       (action-graph (worthwhile-graph graph)))
+(defun travel-time (paths)
+  (loop for (name flow distance) in paths
+        sum (1+ distance)))
+
+(defun next-options (current graph 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 (cddr (assoc current graph :test #'eq)))))
+
+(let* ((open '(aa))
+       (action-graph (worthwhile-graph (data "input"))))
   ;; (path-release)
 
-  (setf (gethash 'aa open) '((aa 0 0)))
   ;; (loop for k being the hash-keys in open using (hash-value v)
   ;;       do (format t "~a=>~a~%" k v))
-  (labels ((traverse (queue open)
-             (unless (null queue)
-               (let ((next (next-options (car queue) action-graph open)))
-                 (traverse (append (cdr queue) next) open)))))
-    (traverse '(aa) open)
-    ;; (let ((queue (next-options 'aa action-graph open )))
-    ;;   (prog1
-    ;;       ;; queue
-    ;;       ;; (caar queue)
-    ;;       (let ((next (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue) next))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         (setq queue (append (cdr queue)
-    ;;                             (next-options (car queue) action-graph open )))
-    ;;         )))
-
-    ;; (next-options 'cc graph open 30)
-
-    (loop for k being the hash-keys in open using (hash-value v)
-          do (format t "~a=>~a f=~a ~%" k v (path-release (reverse v))))
-
-
-
-
-    ))
-
-(adjoin 'l '(b c))
-(defun shortest-path (graph from to)
-  (let ((paths (make-hash-table :test #'eq)))
-    (setf (gethash from paths) (list from))
-    (labels ((traverse (queue paths)
-               (unless (null queue)
-                 (let ((next (next-steps (car queue) graph paths)))
-                   (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)))
+  (labels ((traverse (graph node open time-left current-flow)
+             (let ((next (next-options node graph open time-left)))
+               (if (null next)
+                   current-flow
+                   (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 name (cons name open)
+                                    time-left
+                                    (+ current-flow
+                                       (* flow time-left))))))
+                    (mapcar <> next)
+                    (reduce #'max <>))))))
+    (traverse action-graph 'aa open 30 0)
+    )
+
+
+
+
+  )