aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--AoC2022/16/solver.lisp111
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"))