From 7a22b60ac532af375822ad4fb95ab5aad8c65f6e Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 18 Dec 2022 20:12:33 +0100
Subject: Solving day 16
---
AoC2022/16/solver.lisp | 119 +++++++++++++++++++++++++++++++++++++++----------
1 file changed, 95 insertions(+), 24 deletions(-)
(limited to 'AoC2022/16')
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)))
--
cgit v1.2.3