diff options
Diffstat (limited to 'AoC2022/16')
| -rw-r--r-- | AoC2022/16/solver.lisp | 111 |
1 files changed, 61 insertions, 50 deletions
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp index 66fb622..0366fc3 100644 --- a/AoC2022/16/solver.lisp +++ b/AoC2022/16/solver.lisp @@ -53,7 +53,7 @@ (< (1+ time-there) time-left))))) (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq))))) -(defun path-release (path graph start-time) +(defun path-release-as (path graph start-time) (loop for (from to) on path while to for neighbors = (cddr (assoc from graph :test #'eq)) @@ -63,12 +63,24 @@ sum (* flow (- start-time runtime)) into release finally (return release))) +(defun path-release (path graph start-time) + (loop for (from to) on path + for node-from = (assoc from graph :test #'eq) then node-to + and node-to = (assoc to graph :test #'eq) + while node-to + for neighbors = (cddr node-from) + for flow = (cadr node-to) + for distance = (cdr (assoc 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) (= 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"))) @@ -97,14 +109,6 @@ ;; 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)))) @@ -115,9 +119,6 @@ (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 @@ -126,44 +127,54 @@ ;; '(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))))) +(defun part2 () + (let* ((action-graph (worthwhile-graph (data "eg-in"))) + (start-time 26) + (actor (list `((aa) ,start-time) `((aa) ,start-time)))) + ;; (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 ((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))))) + +(require :sb-sprof) + +(sb-sprof:with-profiling (:max-samples 1000 + :report :flat + :loop t + :show-progress t) + (dotimes (_ 100) + (part2)) + ) +(time (part2)) ;; (length (worthwhile-graph (data "input"))) ;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input")) |