From e30d54735f09475b5fc44f037eab58de688404f9 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 18 Dec 2022 14:11:58 +0100
Subject: traverse but not optimum
---
AoC2022/16/solver.lisp | 144 ++++++++++++++++++++++++++++++++++++++++---------
1 file changed, 120 insertions(+), 24 deletions(-)
(limited to 'AoC2022/16')
diff --git a/AoC2022/16/solver.lisp b/AoC2022/16/solver.lisp
index 6c0a040..6e4a3a1 100644
--- a/AoC2022/16/solver.lisp
+++ b/AoC2022/16/solver.lisp
@@ -1,6 +1,11 @@
(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)
@@ -8,13 +13,17 @@
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)
(and (not (gethash next paths)) ;; not visited
(setf (gethash next paths) (cons next (gethash current paths))))))
- (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))
+ (remove-if-not #'appropriate
+ ;; name flow connections -> cddr
+ (cddr (assoc current graph :test #'eq)))))
(defun shortest-path (graph from to)
(let ((paths (make-hash-table :test #'eq)))
@@ -29,36 +38,123 @@
;; do (format t "~a=>~a~%" k v))
(gethash to paths)))
-(defun path-release (path)
- (loop for ((name flow) . distance) in path
+(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
sum (* flow (- 30 runtime)) into release
finally (return release)))
-(= 340 (path-release '(((a 5) . 1) ((b 8) . 2))))
+(= 340 (path-release '((a 5 1) (b 8 2))))
(shortest-path (data "eg-in") 'AA 'CC)
-(defun next-options (current graph visited)
- (flet ((appropriate (next)
- (and (not (gethash next paths)) ;; not visited
- (setf (gethash next paths) (cons next (gethash current paths))))))
- (remove-if-not #'appropriate (cddr (assoc current graph :test #'eq))))
- )
-q
-(let* ((graph (data "eg-in"))
- (interesting (remove-if #'zerop graph :key #'cadr))
- (open nil))
-
+(defun close-option (interesting graph visited)
(sort
(mapcar (lambda (node)
- (cons (subseq node 0 2)
- (length (shortest-path graph 'aa (car node)))))
+ (setf (gethash (car node) visited)
+ (cons (move-to node 'aa graph) (gethash 'aa visited))) )
interesting)
#'>
- :key (lambda (destination)
- (destructuring-bind ((name flow) . distance) destination
- ;; because start is in path take that as valve opening time
- (- flow distance))))
- )
+ :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)
+ collect (nconc (list from flow)
+ (loop for (to) in interesting
+ 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)))
+ ;; (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)
-(adjoin 'c '(b c))
+ (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)))
--
cgit v1.2.3