From 810a45b40096ff75b80a2e96325ac61105b35c58 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Mon, 18 Dec 2023 01:17:13 +0100
Subject: cleanup
---
AoC2023/day17/solver.lisp | 119 +++++++++++++---------------------------------
1 file 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"))))
--
cgit v1.2.3