traverse but not optimum

1 files changed, 120 insertions, 24 deletions

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 6c0a040..6e4a3a1 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -1,6 +1,11 @@
 
 (ql:quickload '(fiveam cl-ppcre uiop arrows))
 
+(defstruct valve
+  name
+  flow
+  connections)
+
 (defun data (filename)
   (with-open-file (in filename)
     (loop for line = (read-line in nil nil)
@@ -8,13 +13,17 @@
           collect (cl-ppcre:register-groups-bind (val (#'parse-integer flow) others)
                       ("Valve (\\w+) has flow rate=(\\d+); tunnels? leads? to valves? (.+)" line)
                     `(,(intern val) ,flow ,@(mapcar #'intern (cl-ppcre:split ", " others)))))))
-
+(let ((gra (list (make-valve :name 'aa :connections '(bb cc))
+                 (make-valve :name 'bb :connections '(ll cc)))))
+  (valve-connections (find 'll gra :key #'valve-name)))
 
 (defun next-steps (current graph paths)
   (flet ((appropriate (next)
            (and (not (gethash next paths)) ;; not visited
                 (setf (gethash next paths) (cons next (gethash current paths))))))
-    (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))
+    (remove-if-not #'appropriate
+                   ;; name flow connections -> cddr
+                   (cddr (assoc current graph :test #'eq)))))
 
 (defun shortest-path (graph from to)
   (let ((paths (make-hash-table :test #'eq)))
@@ -29,36 +38,123 @@
     ;;       do (format t "~a=>~a~%" k v))
     (gethash to paths)))
 
-(defun path-release (path)
-  (loop for ((name flow) . distance) in path
+(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
         sum (* flow (- 30 runtime)) into release
         finally (return release)))
 
-(= 340 (path-release '(((a 5) . 1) ((b 8) . 2))))
+(= 340 (path-release '((a 5 1) (b 8 2))))
 (shortest-path (data "eg-in") 'AA 'CC)
 
-(defun next-options (current graph visited)
-  (flet ((appropriate (next)
-           (and (not (gethash next paths)) ;; not visited
-                (setf (gethash next paths) (cons next (gethash current paths))))))
-    (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq))))
-  )
-q
-(let* ((graph (data "eg-in"))
-       (interesting (remove-if #'zerop graph :key #'cadr))
-       (open nil))
-
+(defun close-option (interesting graph visited)
   (sort
    (mapcar (lambda (node)
-             (cons (subseq node 0 2)
-                   (length (shortest-path graph 'aa (car node)))))
+            (setf (gethash (car node) visited)
+                  (cons (move-to node 'aa graph) (gethash 'aa visited))) )
            interesting)
    #'>
-   :key (lambda (destination)
-          (destructuring-bind ((name flow) . distance) destination
-            ;; because start is in path take that as valve opening time
-            (- flow distance))))
-  )
+   :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)
+          collect (nconc (list from flow)
+                         (loop for (to) in interesting
+                               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)))
+  ;; (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)
 
-(adjoin 'c '(b c))
+    (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)))