aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2022-12-19 13:24:10 +0100
committerOscar Najera <hi@oscarnajera.com>2022-12-19 13:24:10 +0100
commit6c39f4526fed2c271a909cbd6b3f48f5b25f28ae (patch)
tree3fb783a97f583e743e43119a362f2dcca62ada24
parent6970fcacf00860cf6b7ab04b61c58dc2935d53c4 (diff)
downloadscratch-6c39f4526fed2c271a909cbd6b3f48f5b25f28ae.tar.gz
scratch-6c39f4526fed2c271a909cbd6b3f48f5b25f28ae.tar.bz2
scratch-6c39f4526fed2c271a909cbd6b3f48f5b25f28ae.zip
Create directly next moves list
Test in place for suitably. Instead of a copy of the travel times create a new list that is more useful
-rw-r--r--AoC2022/16/solver.lisp31
1 files changed, 17 insertions, 14 deletions
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 158704d..6f0f254 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -100,25 +100,30 @@
(defun accumulated-flow (actor-paths)
(reduce #'+ actor-paths :key #'caddr))
-(defun appropriate (node open time-left)
- (destructuring-bind (next-node-name . time-there) node
- (and (zerop (logand next-node-name open))
- (< (1+ time-there) time-left))))
-
(defun traverse (graph actor open)
(if (loop for ac in actor
:always (zerop (cadr ac)))
(mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor)
(advance graph actor open)))
+;; (let ((graph (worthwhile-graph (data "eg-in"))))
+
+;; )
+
+
(defun advance (graph actor open)
(destructuring-bind (path time-left previous-flow) (car actor)
(let* ((current-options (assoc (car path) graph :test #'=))
+ (travel-times (cdddr current-options))
(flow-released (caddr current-options))
(current-flow (+ previous-flow (* flow-released time-left)))
- (next (remove-if-not (lambda (node)
- (appropriate node open time-left))
- (cdddr current-options))))
+ (next
+ (loop for (node . time-there) in travel-times
+ :when (and (not (logtest node open))
+ (let ((time-left (- time-left time-there 1)))
+ (when (plusp time-left)
+ (cons node (list (list (cons node path) time-left current-flow))))))
+ :collect it)))
(if (null next)
(traverse graph
(append (cdr actor)
@@ -126,13 +131,11 @@
open)
(arrows:->
- (loop for (name . time-there) in next
+ (loop for (node . actor-next-move) in next
collect
- (let ((time-left (- time-left time-there 1)))
- (traverse graph
- (append (cdr actor) (list (list (cons name path) time-left
- current-flow)))
- (logior name open))))
+ (traverse graph
+ (append (cdr actor) actor-next-move)
+ (logior node open)))
(sort #'>= :key #'accumulated-flow)
(car))))))