Solving day 16

1 files changed, 95 insertions, 24 deletions

diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 1e161cf..66fb622 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -1,11 +1,6 @@
 
 (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)
@@ -13,9 +8,6 @@
           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)
@@ -38,9 +30,6 @@
     ;;       do (format t "~a=>~a~%" k v))
     (gethash to paths)))
 
-(= 340 (path-release '((a 5 1) (b 8 2))))
-(shortest-path (data "eg-in") 'AA 'CC)
-
 (defun worthwhile-graph (graph)
   (let ((interesting (remove-if #'zerop graph :key #'cadr)))
     (loop for (from flow) in (cons '(aa 0) interesting)
@@ -49,9 +38,13 @@
                                when (not (eq from to))
                                  collect (cons to (1- (length (shortest-path graph from to)))))))))
 
-(defun travel-time (paths)
-  (loop for (name flow distance) in paths
-        sum (1+ distance)))
+(defun travel-time (path graph)
+  (loop for (from to) on path
+        while to
+        for neighbors = (cddr (assoc from graph :test #'eq))
+        for distance = (cdr (assoc to neighbors :test #'eq))
+        sum (1+ distance) into runtime
+        collect runtime))
 
 (defun next-options (current graph open time-left)
   (flet ((appropriate (next)
@@ -60,22 +53,26 @@
                   (< (1+ time-there) time-left)))))
     (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))
 
-(defun path-release (path graph)
+(defun path-release (path graph start-time)
   (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
+        sum (* flow (- start-time 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"))))
+(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"))))
+       (action-graph (worthwhile-graph (data "input")))
+       (start-time 30))
   ;; (path-release)
 
   ;; (loop for k being the hash-keys in open using (hash-value v)
@@ -83,8 +80,7 @@
   (labels ((traverse (graph node open time-left current-flow)
              (let ((next (next-options node graph open time-left)))
                (if (null next)
-                   (let ((res (reverse open)))
-                     (list (path-release res graph) res))
+                   (reverse open)
                    (arrows:->
                     (lambda (next-node)
                       (destructuring-bind (name . time-there) next-node
@@ -95,6 +91,81 @@
                                     (+ current-flow
                                        (* flow time-left))))))
                     (mapcar next)
-                    (sort #'>= :key #'car)
+                    (sort #'>= :key (lambda (path) (path-release path graph start-time)))
                     (car))))))
-    (apply #'values (traverse action-graph 'aa open 30 0))))
+    (traverse action-graph 'aa open start-time 0)))
+
+;; 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))))
+
+
+(path-release '(AA DD) (worthwhile-graph (data "eg-in")) 26)
+(path-release '(AA DD EE) (worthwhile-graph (data "eg-in")) 26)
+(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
+;;  ;; '(AA NU WK NC ZG XK YH NM YP)
+;;  ;; '(AA NU WK NC ZG EA CX QC)
+;;     '(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)))))
+
+;; (length (worthwhile-graph (data "input")))
+
+;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input"))
+;;       do (loop for (nn . dist) in neighbors
+;;                do (format t "~a -> ~a [label=\"~d\"]~%" name nn dist)))