diff options
| -rw-r--r-- | AoC2022/16/solver.lisp | 134 |
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) + ) + + + + + ) |