Clean up, heretic use of mutation

1 files changed, 68 insertions, 57 deletions

diff --git a/AoC2022/24/solver.lisp b/AoC2022/24/solver.lisp
index 0961b6f..24725ef 100644
--- a/AoC2022/24/solver.lisp
+++ b/AoC2022/24/solver.lisp
@@ -35,13 +35,22 @@
 
 (fiveam:test boundaries
   (let ((bc (boundary-conditions 6 9)))
-    (fiveam:is (equal (funcall bc 5 3 t) '(1 3 t)))
-    (fiveam:is (equal (funcall bc 5 8 t) '(1 1 t)))
-    (fiveam:is (equal (funcall bc 0 8 t) '(4 1 t)))))
+    (fiveam:is (equal (funcall bc 5 3 t) '(t 1 3)))
+    (fiveam:is (equal (funcall bc 5 8 t) '(t 1 1)))
+    (fiveam:is (equal (funcall bc 0 8 t) '(t 4 1)))))
+
+(defstruct valley
+  blizzards
+  boundaries
+  wallp
+  size)
 
 (defun data-input (filename)
-  (let ((lines (uiop:read-file-lines filename)))
-    (list
+  (let* ((lines (uiop:read-file-lines filename))
+         (width (length (car lines)))
+         (height (length lines)))
+    (make-valley
+     :blizzards
      (loop for row in lines
            and y from 0
            nconc (loop for place across row
@@ -53,30 +62,33 @@
                                          (#\v 'v)
                                          (#\^ '^))
                                        x y)))
-     (list (length (car lines))
-           (length lines)))))
+     :boundaries (boundary-conditions width height)
+     :wallp (wall-p width height)
+     :size (list width height))))
 
-(defun evolve (blizzards boundary)
-  (mapcar
-   (lambda (blizzard)
-     (trivia:match blizzard
-       ((list '> x y) (funcall boundary (1+ x) y '>))
-       ((list '< x y) (funcall boundary (1- x) y '<))
-       ((list 'v x y) (funcall boundary x (1+ y) 'v))
-       ((list '^ x y) (funcall boundary x (1- y) '^))))
-   blizzards))
+(defun evolve (valley)
+  (with-slots (blizzards boundaries) valley
+    (mapcar
+     (lambda (blizzard)
+       (trivia:match blizzard
+         ((list '> x y) (funcall boundaries (1+ x) y '>))
+         ((list '< x y) (funcall boundaries (1- x) y '<))
+         ((list 'v x y) (funcall boundaries x (1+ y) 'v))
+         ((list '^ x y) (funcall boundaries x (1- y) '^))))
+     blizzards)))
 
 
-(defun elf-moves (elf wallp blizzards)
-  (destructuring-bind (x y) elf
-    (arrows:-<>
-     (list (list (1+ x)    y)
-           (list x     (1+ y))
-           (list (1- x)    y)
-           (list x     (1- y))
-           (list x         y))
-     (delete-if wallp <>)
-     (set-difference <> (mapcar #'cdr blizzards) :test #'equal))))
+(defun elf-moves (elf valley)
+  (with-slots (blizzards wallp) valley
+    (destructuring-bind (x y) elf
+      (arrows:-<>
+       (list (list (1+ x)    y)
+             (list x     (1+ y))
+             (list (1- x)    y)
+             (list x     (1- y))
+             (list x         y))
+       (delete-if wallp <>)
+       (set-difference <> (mapcar #'cdr blizzards) :test #'equal)))))
 
 (defun cutoff-distance (positions goal)
   (loop for p in positions
@@ -92,37 +104,36 @@
 (defun discard-hopeless-positions (positions goal cutoff-distance)
   (delete-if (lambda (p) (< cutoff-distance (distance-1 goal p))) positions))
 
-(defun time-step (time-left walkers goal blizzards bc wallp)
+(defun time-step! (time-left walkers goal valley)
   (if (or (zerop time-left) (member goal walkers :test #'equal))
-      (values time-left blizzards)
-      (let* ((new-blizzards (evolve blizzards bc))
-             (new-positions (reduce
-                             (lambda (options point)
-                               (union options (elf-moves point wallp new-blizzards)
-                                      :test #'equal))
-                             walkers
-                             :initial-value nil))
-             (shortened-positions (discard-hopeless-positions new-positions goal
-                                               (cutoff-distance new-positions goal))))
-        (time-step (1- time-left)
-                   shortened-positions
-                   goal new-blizzards bc wallp))))
-
-(destructuring-bind (blizzards (width height)) (data-input "input")
-  (let ((bc (boundary-conditions width height))
-        (wallp (wall-p width height))
-        (goal (list (- width 2) (1- height)))
-        (elf (list 1 0))
-        (max-time 400))
-    (multiple-value-bind (time-left-g blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
-      (multiple-value-bind (time-left-b blizzards) (time-step max-time (list goal) elf blizzards bc wallp)
-        (multiple-value-bind (time-left-e blizzards) (time-step max-time (list elf) goal blizzards bc wallp)
-          (list (- max-time time-left-g)
-                (- max-time time-left-b)
-                (- max-time time-left-e)))))
+      time-left
+      (progn
+        (setf (valley-blizzards valley) (evolve valley))
+        (let* ((new-positions (reduce
+                               (lambda (options point)
+                                 (union options (elf-moves point valley) :test #'equal))
+                               walkers
+                               :initial-value nil))
+               (shortened-positions (discard-hopeless-positions new-positions goal
+                                                                (cutoff-distance new-positions goal))))
+          (time-step! (1- time-left)
+                      shortened-positions
+                      goal valley)))))
 
-    )
+(defun solver (filename repeats)
+  (let ((valley (data-input filename)))
+    (destructuring-bind (width height) (valley-size valley)
+      (let ((exit (list (- width 2) (1- height)))
+            (start (list 1 0))
+            (max-time 500))
+        (loop for (start goal) on (loop with l = (list start exit)
+                                        repeat repeats
+                                        append l)
+              while goal
+              sum (- max-time (time-step! max-time (list start) goal valley)))))))
 
-  )
-(+ 299 348 252)
-(+ 299 323 277)
+(fiveam:test solutions
+  (fiveam:is (= 18 (solver "eg-in" 1)))
+  (fiveam:is (= 299 (solver "input" 1)))
+  (fiveam:is (= 54 (solver "eg-in" 2)))
+  (fiveam:is (= 899 (solver "input" 2))))