aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2022-12-18 15:04:14 +0100
committerOscar Najera <hi@oscarnajera.com>2022-12-18 15:04:14 +0100
commitde81215e8e0b027fc591aec263314afa00c7923e (patch)
tree1a3427d1bd96583e0c3e0cca199ea69584b6512b
parente30d54735f09475b5fc44f037eab58de688404f9 (diff)
downloadscratch-de81215e8e0b027fc591aec263314afa00c7923e.tar.gz
scratch-de81215e8e0b027fc591aec263314afa00c7923e.tar.bz2
scratch-de81215e8e0b027fc591aec263314afa00c7923e.zip
LISP solve part 1 day 16
-rw-r--r--AoC2022/16/solver.lisp134
1 files changed, 35 insertions, 99 deletions
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 6e4a3a1..5eddea1 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -38,10 +38,6 @@
;; do (format t "~a=>~a~%" k v))
(gethash to paths)))
-(defun travel-time (paths)
- (loop for (name flow distance) in paths
- sum (1+ distance)))
-
(defun path-release (paths)
(loop for (name flow distance) in paths
sum (1+ distance) into runtime
@@ -51,22 +47,6 @@
(= 340 (path-release '((a 5 1) (b 8 2))))
(shortest-path (data "eg-in") 'AA 'CC)
-(defun close-option (interesting graph visited)
- (sort
- (mapcar (lambda (node)
- (setf (gethash (car node) visited)
- (cons (move-to node 'aa graph) (gethash 'aa visited))) )
- interesting)
- #'>
- :key (lambda (path) (path-release (reverse path)))))
-
-(defun make-edge (from to)
- (intern
- (concatenate 'string
- (symbol-name from)
- "-"
- (symbol-name to))))
-
(defun worthwhile-graph (graph)
(let ((interesting (remove-if #'zerop graph :key #'cadr)))
(loop for (from flow) in (cons '(aa 0) interesting)
@@ -75,86 +55,42 @@
when (not (eq from to))
collect (cons to (1- (length (shortest-path graph from to)))))))))
-(worthwhile-graph
- (data "eg-in"))
-
-(defun next-options (current graph visited)
- (let ((to-this-node (gethash current visited)))
- (flet ((appropriate (next)
- (destructuring-bind (next-node-name . time-there) next
- (let* ((route-to-next (gethash next-node-name visited))
- (next-node-flow (cadr (assoc next-node-name graph :test #'eq)))
- (move-to-next (list next-node-name next-node-flow time-there)))
- (when (or (and (not route-to-next)
- (< (1+ time-there) (- 30 (travel-time to-this-node))))
- (and (not (member next-node-name to-this-node :key #'car))
- (< (path-release route-to-next)
- (path-release (cons move-to-next to-this-node)))))
- (setf (gethash (car next) visited)
- (cons move-to-next (gethash current visited))))))))
- (arrows:-<>
- (mapcar #'appropriate (cddr (assoc current graph :test #'eq)))
- (delete nil <>)
- ;; (sort <> #'> :key (lambda (path) (path-release (reverse path))))
- (mapcar #'caar <>)))))
-
-(let* ((graph (data "eg-in"))
- (open (make-hash-table :test #'eq))
- (action-graph (worthwhile-graph graph)))
+(defun travel-time (paths)
+ (loop for (name flow distance) in paths
+ sum (1+ distance)))
+
+(defun next-options (current graph open time-left)
+ (flet ((appropriate (next)
+ (destructuring-bind (next-node-name . time-there) next
+ (and (not (member next-node-name open :test #'eq))
+ (< (1+ time-there) time-left)))))
+ (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))
+
+(let* ((open '(aa))
+ (action-graph (worthwhile-graph (data "input"))))
;; (path-release)
- (setf (gethash 'aa open) '((aa 0 0)))
;; (loop for k being the hash-keys in open using (hash-value v)
;; do (format t "~a=>~a~%" k v))
- (labels ((traverse (queue open)
- (unless (null queue)
- (let ((next (next-options (car queue) action-graph open)))
- (traverse (append (cdr queue) next) open)))))
- (traverse '(aa) open)
- ;; (let ((queue (next-options 'aa action-graph open )))
- ;; (prog1
- ;; ;; queue
- ;; ;; (caar queue)
- ;; (let ((next (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue) next))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; (setq queue (append (cdr queue)
- ;; (next-options (car queue) action-graph open )))
- ;; )))
-
- ;; (next-options 'cc graph open 30)
-
- (loop for k being the hash-keys in open using (hash-value v)
- do (format t "~a=>~a f=~a ~%" k v (path-release (reverse v))))
-
-
-
-
- ))
-
-(adjoin 'l '(b c))
-(defun shortest-path (graph from to)
- (let ((paths (make-hash-table :test #'eq)))
- (setf (gethash from paths) (list from))
- (labels ((traverse (queue paths)
- (unless (null queue)
- (let ((next (next-steps (car queue) graph paths)))
- (unless (member to next :test #'eq)
- (traverse (append (cdr queue) next) paths))))))
- (traverse (list from) paths))
- ;; (loop for k being the hash-keys in paths using (hash-value v)
- ;; do (format t "~a=>~a~%" k v))
- (gethash to paths)))
+ (labels ((traverse (graph node open time-left current-flow)
+ (let ((next (next-options node graph open time-left)))
+ (if (null next)
+ current-flow
+ (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 name (cons name open)
+ time-left
+ (+ current-flow
+ (* flow time-left))))))
+ (mapcar <> next)
+ (reduce #'max <>))))))
+ (traverse action-graph 'aa open 30 0)
+ )
+
+
+
+
+ )