optimized diffusion

1 files changed, 31 insertions, 22 deletions

diff --git a/AoC2023/day21/solver.lisp b/AoC2023/day21/solver.lisp
index f901d54..87c70c4 100644
--- a/AoC2023/day21/solver.lisp
+++ b/AoC2023/day21/solver.lisp
@@ -13,31 +13,40 @@
         (when (eq (aref field row col) #\S)
           (return-from find-start (list row col)))))))
 
-(defun next-moves (field)
-  (destructuring-bind (rows cols)
-      (array-dimensions field)
-    (lambda (pos)
-      (destructuring-bind (row col) pos
-        (loop for (dr dc) in '((0 1) (0 -1) (1 0) (-1 0))
-              for nr = (+ row dr)
-              for nc = (+ col dc)
-              when (and (< -1 nr rows)
-                        (< -1 nc cols)
-                        (not (eq #\# (aref field nr nc))))
-                collect (list nr nc))))))
-
 (let* ((lines
          (uiop:read-file-lines "input"))
        (field (make-array (list (length lines) (length (car lines)))
                           :initial-contents lines))
-       (walker (next-moves field)))
-  (labels ((all-places (positions)
-             (delete-duplicates (mapcan walker positions) :test #'equal)))
+       end-positions
+       pending
+       (start (find-start field))
+       (visited (make-hash-table :test #'equal))
+       )
+  (push (cons 64 start) pending)
+  (setf (gethash start visited) t)
+
+  (destructuring-bind (rows cols)
+      (array-dimensions field)
+    (loop while pending
+          for (steps-left row col) = (pop pending) do
+            (when (zerop (mod steps-left 2))
+              (push (list row col) end-positions))
+            (unless (zerop steps-left)
+              (loop
+                for (dr dc) in '((0 1) (0 -1) (1 0) (-1 0))
+                for nr = (+ row dr)
+                for nc = (+ col dc)
+                for new-pos = (list nr nc)
+                when (and (< -1 nr rows)
+                          (< -1 nc cols)
+                          (not (eq #\# (aref field nr nc)))
+                          (not (gethash new-pos visited)))
+                  do (setf (gethash new-pos visited) t)
+                     (push (cons (1- steps-left) new-pos) pending)))))
+  ;; (list
+  ;;  end-positions)
+  ;; (length (remove-duplicates end-positions :test #'equal))
+  (length
+   end-positions)
 
-    (loop
-      repeat 64
-      for positions = (all-places (list (find-start field)))
-        then (all-places positions)
-      ;; do (print positions)
-      finally (return (length positions))))
   )