From 8a953ffd9d0621346535060c31d1fc5772243ff3 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 18 Dec 2022 22:47:20 +0100
Subject: Logical path test instead of member
---
AoC2022/16/solver.lisp | 44 +++++++++++++++++++++-----------------------
1 file changed, 21 insertions(+), 23 deletions(-)
(limited to 'AoC2022')
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index bdd8fc3..0b3e309 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -1,4 +1,3 @@
-
(ql:quickload '(fiveam cl-ppcre uiop arrows))
(defun data (filename)
@@ -31,16 +30,14 @@
(gethash to paths)))
(defun worthwhile-graph (graph)
- (let ((interesting (remove-if #'zerop graph :key #'cadr))
- (htgraph (make-hash-table :test #'eq :size 16)))
+ (let ((interesting (remove-if #'zerop graph :key #'cadr)))
(loop for (from flow) in (cons '(aa 0) interesting)
- do
- (setf (gethash from htgraph)
- (cons flow
+ for label from 0
+ collect (apply #'list (ash 1 label) from flow
(loop for (to) in interesting
+ for target-label from 1
when (not (eq from to))
- collect (cons to (1- (length (shortest-path graph from to))))))))
- htgraph))
+ collect (cons (ash 1 target-label) (1- (length (shortest-path graph from to)))))))))
(defun travel-time (path graph)
(loop for (from to) on path
@@ -53,9 +50,9 @@
(defun next-options (current-options open time-left)
(flet ((appropriate (next)
(destructuring-bind (next-node-name . time-there) next
- (and (not (member next-node-name open :test #'eq))
+ (and (zerop (logand next-node-name open))
(< (1+ time-there) time-left)))))
- (remove-if-not #'appropriate (cdr current-options))))
+ (remove-if-not #'appropriate (cdddr current-options))))
(defun path-release-as (path graph start-time)
(loop for (from to) on path
@@ -69,17 +66,18 @@
(defun path-release (path graph start-time)
(loop for (from to) on path
- for node-from = (gethash from graph) then node-to
- and node-to = (gethash to graph)
+ for node-from = (rassoc from graph :key #'car) then node-to
+ and node-to = (rassoc to graph :key #'car)
while node-to
- for neighbors = (cdr node-from)
- for flow = (car node-to)
- for distance = (cdr (assoc to neighbors :test #'eq))
+ for neighbors = (cdddr node-from)
+ for flow = (caddr node-to)
+ for distance = (cdr (assoc (car node-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)
+
(fiveam:test loads
(fiveam:is
(= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in")) 30)))
@@ -111,7 +109,7 @@
(defun solver (filename start-time actors)
(let* ((action-graph (worthwhile-graph (data filename)))
- (actor (loop repeat actors collect `((aa) ,start-time 0))))
+ (actor (loop repeat actors collect `((1) ,start-time 0))))
(labels ((traverse (graph actor open)
(if (loop for ac in actor
:always (zerop (cadr ac)))
@@ -121,8 +119,8 @@
;; (princ (path-release2 (reverse open) graph start-time))
;; (princ (recover-paths (reverse open)))
;; (terpri)
- (let* ((current-options (gethash (car path) graph))
- (flow-released (car current-options))
+ (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)))
(if (null next)
@@ -138,13 +136,13 @@
(traverse graph
(append (cdr actor) (list (list (cons name path) time-left
current-flow)))
- (cons name open)))))
+ (logior name open)))))
(mapcar next)
(sort #'>= :key #'accumulated-flow)
(car))))))))
;; (princ)
- (traverse action-graph actor '(aa)))))
+ (traverse action-graph actor 1))))
(fiveam:test solutions
(fiveam:is
@@ -164,9 +162,9 @@
;; :loop t
;; :show-progress t)
;; (dotimes (_ 100)
-;; (part2 "eg-in"))
-;; )
-;; (time (part2 "eg-in"))
+;; (solver "eg-in" 30 1)))
+
+;; (time (solver "eg-in" 30 1))
;; (length (worthwhile-graph (data "input")))
;; (loop for (name flow . neighbors) in (worthwhile-graph (data "input"))
--
cgit v1.2.3