diff options
Diffstat (limited to 'AoC2022/16')
| -rw-r--r-- | AoC2022/16/solver.lisp | 119 |
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))) |