From 31e13af961488ed409f402e396189f8aa72250e1 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Mon, 19 Dec 2022 00:22:32 +0100
Subject: appropriate only does check no next-options redef
---
AoC2022/16/solver.lisp | 24 ++++++++++--------------
1 file changed, 10 insertions(+), 14 deletions(-)
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 78ed896..43cb8d7 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -47,12 +47,10 @@
sum (1+ distance) into runtime
collect runtime))
-(defun next-options (current-options open time-left)
- (flet ((appropriate (next)
- (destructuring-bind (next-node-name . time-there) next
- (and (zerop (logand next-node-name open))
- (< (1+ time-there) time-left)))))
- (remove-if-not #'appropriate (cdddr current-options))))
+(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 path-release-as (path graph start-time)
(loop for (from to) on path
@@ -107,6 +105,7 @@
(defun accumulated-flow (actor-paths)
(reduce #'+ actor-paths :key #'caddr))
+
(defun solver (filename start-time actors)
(let* ((action-graph (worthwhile-graph (data filename)))
(actor (loop repeat actors collect `((1) ,start-time 0))))
@@ -115,14 +114,12 @@
:always (zerop (cadr ac)))
(mapcar (lambda (a) (cons (reverse (car a)) (cdr a))) actor)
(destructuring-bind (path time-left previous-flow) (car actor)
- ;; (princ (car actor))
- ;; (princ (path-release2 (reverse open) graph start-time))
- ;; (princ (recover-paths (reverse open)))
- ;; (terpri)
(let* ((current-options (assoc (car path) graph :test #'=))
(flow-released (caddr current-options))
(current-flow (+ previous-flow (* flow-released time-left)))
- (next (next-options current-options open time-left)))
+ (next (remove-if-not (lambda (node)
+ (appropriate node open time-left))
+ (cdddr current-options))))
(if (null next)
(traverse graph
(append (cdr actor)
@@ -160,10 +157,9 @@
;; :report :flat
;; :loop t
;; :show-progress t)
-;; (dotimes (_ 100)
-;; (solver "eg-in" 30 1)))
+;; (solver "input" 19 2))
-;; (time (solver "eg-in" 30 1))
+;; (time (solver "input" 19 2))
;; (length (worthwhile-graph (data "input")))
;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input"))
--
cgit v1.2.3