diff options
| -rw-r--r-- | AoC2022/16/solver.lisp | 144 |
1 files changed, 120 insertions, 24 deletions
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))) |