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