diff options
| -rw-r--r-- | AoC2023/day17/solver.lisp | 119 |
1 files changed, 33 insertions, 86 deletions
diff --git a/AoC2023/day17/solver.lisp b/AoC2023/day17/solver.lisp index 94598db..7001eb8 100644 --- a/AoC2023/day17/solver.lisp +++ b/AoC2023/day17/solver.lisp @@ -2,10 +2,9 @@ ;; (ql:quickload '(fiveam arrows cl-heap)) -(defun in-bounds (field crucible) +(defun in-bounds (field position) (destructuring-bind (maxrow maxcol) (array-dimensions field) - (destructuring-bind (dir row col) crucible - (declare (ignorable dir)) + (destructuring-bind (row col) position (and (< -1 row maxrow) (< -1 col maxcol))))) @@ -28,11 +27,6 @@ line)) input)))) -(defstruct (walker (:copier nil)) - (path (make-hash-table :test #'equal)) - dir row col - (track 0)) - (defun backtrack (dir) (ecase dir (up 'dw) @@ -40,93 +34,46 @@ (dw 'up) (lf 'rt))) -(defun next-direction (walker adv) - (with-slots (path dir track) walker - (destructuring-bind (move nrow ncol) adv - (let ((np (alexandria:copy-hash-table path))) - (setf (gethash adv np) t) - (make-walker :path np - :dir move - :row nrow - :col ncol - :track (if (eq move dir) (1+ track) 0)))))) - (defun next-moves (field tried walker) - (with-slots (dir row col track) walker + (destructuring-bind (track dir row col) walker (arrows:->> (remove dir '(rt dw lf up) :key #'backtrack) - (remove-if (lambda (d) (and (eq d dir) - (<= 2 track)))) - (mapcar (alexandria:curry #'advance row col)) - (remove-if-not (alexandria:curry #'in-bounds field)) - (remove-if (lambda (p) - (gethash (cons (if (eq (car p) dir) (1+ track) 0) p) tried))) - (mapcar (lambda (p) - (let ((nt (if (eq (car p) dir) (1+ track) 0))) - (setf (gethash (cons nt p) tried) t) - (next-direction walker p) - ;; (destructuring-bind (dir row col) p - ;; (make-walker :dir dir :row row :col col :track nt)) - ))) - ;; (mapcar (lambda (d) (next-direction walker d))) - ))) + (mapcar (lambda (d) + (unless (and (eq d dir) (<= 2 track)) + (destructuring-bind (ndir . np) (advance row col d) + (when (in-bounds field np) + (let* ((nt (if (eq ndir dir) (1+ track) 0)) + (npath (list* nt ndir np))) + (unless (gethash npath tried) + (setf (gethash npath tried) t) + npath))))))) + (delete nil)))) (defun finish-p (field step) (destructuring-bind (maxrow maxcol) (array-dimensions field) - (with-slots (row col) step + (destructuring-bind (row col) (cddr step) (and (= row (1- maxrow)) (= col (1- maxcol)))))) -(defun path-cost (field walker) - (let ((cost 0)) - (maphash (lambda (k v) - (declare (ignorable v)) - (destructuring-bind (dir row col) k - (declare (ignorable dir)) - (incf cost (aref field row col)))) - (walker-path walker)) - cost)) - - -(defun try (options known field iters) - (let ((next (cl-heap:dequeue options))) - ;; (with-slots (dir row col) next - ;; (format t "i: ~d cost: ~d/~d p: ~a~%" iters (path-cost field next) (hash-table-count (walker-path next)) (list dir row col))) - (when next - (if (finish-p field next) - (progn (format t "Took ~d iters\n" iters) - next) - (progn - (dolist (newm (next-moves field known next)) - (cl-heap:enqueue options - newm - (path-cost field newm))) - ;; (print (cl-heap:queue-size options)) - (try options known field (1+ iters)))))) +(defun vdequeue (q) + (cl-heap:pop-heap (slot-value q 'cl-heap:heap))) - ) +(defun walk (options known field) + (loop for (pcost current) = (vdequeue options) + while current + until (finish-p field current) + do (dolist (next (next-moves field known current)) + (cl-heap:enqueue options next (+ (apply #'aref field (cddr next)) pcost))) + finally (return pcost))) -(let* ((field (parse-input "input")) - ;; (maxloss (apply #'* 9 (array-dimensions field))) - (options (make-instance 'cl-heap:priority-queue)) - (known (make-hash-table :test #'equal)) - (w (make-walker :dir 'rt :row 0 :col 0))) - ;; (setf (gethash '(rt 0 0) (walker-path w)) 1) - ;; (next-moves field w) - ;; (carry field w maxloss 0) - ;; (cl-heap:dequeue - ;; options) - (cl-heap:enqueue options w 0) - ;; (cl-heap:enqueue options '(rt 0 0 0) 0) - ;; options - ;; (print) - (time - (let ((r - (try options known field 0))) - (list (path-cost field r) r))) - ) +(defun solver (filename) + (let* ((field (parse-input filename)) + (options (make-instance 'cl-heap:priority-queue)) + (known (make-hash-table :test #'equal)) + (w (list -1 'rt 0 0))) + (cl-heap:enqueue options w 0) + (walk options known field))) -;; (let ( (w (make-walker :dir 'rt :row 0 :col 0)) -;; (y (make-walker :dir 'rt :row 0 :col 0)) ) -;; (equalp w y)) -;; (make-hash-table :test #'equalp) +(fiveam:test solutions + (fiveam:is (= 102 (solver "eg-in"))) + (fiveam:is (= 963 (solver "input")))) |