commit - 2b9c8dd94c27169b528d83a00011cc6f90e4a151
commit + 66456ba8fb5ceb69ad7ea2f2c8fcc757a6b6e405
blob - 660c062466a831c0ef2e5c93314490beeee4977a
blob + 1036bc1e737e5c62bc10c1cd37ac1db41248b47a
--- src/day-17.lisp
+++ src/day-17.lisp
@@ -13,7 +13,15 @@
                             :right (:up :down)
                             :down (:left :right)))
 
-(defun next-steps (map pos dir steps closed)
+(defun make-side-in-map-p (map closed)
+  (lambda (side)
+    (or (< (point-x (car side)) 0)
+        (< (point-y (car side)) 0)
+        (>= (point-x (car side)) (input-map-width map))
+        (>= (point-y (car side)) (input-map-height map))
+        (gethash side closed))))
+
+(defun next-steps-crucible (map pos dir steps closed)
   (let (sides)
     (when (< steps 3)
       (push (list (point+ pos (getf *dirs* dir))
@@ -25,17 +33,25 @@
                          next
                          1)
                    sides))
-    (remove-if (lambda (side)
-                 (or (< (point-x (car side)) 0)
-                     (< (point-y (car side)) 0)
-                     (>= (point-x (car side)) (input-map-width map))
-                     (>= (point-y (car side)) (input-map-height map))
-                     (gethash side closed)))
-               sides)))
+    (remove-if (make-side-in-map-p map closed) sides)))
 
-(defun day-17 (input)
-  (loop with map = (make-map input)
-        with todo = (let ((q (make-queue :priority-queue :compare (lambda (a b)
+(defun next-steps-ultra-crucible (map pos dir steps closed)
+  (let (sides)
+    (when (< steps 10)
+      (push (list (point+ pos (getf *dirs* dir))
+                  dir
+                  (1+ steps))
+            sides))
+    (when (> steps 3)
+      (loop for next in (getf *next-dirs* dir)
+            do (push (list (point+ pos (getf *dirs* next))
+                           next
+                           1)
+                     sides)))
+    (remove-if (make-side-in-map-p map closed) sides)))
+
+(defun find-path-with-lowest-head-loss (map next-steps)
+  (loop with todo = (let ((q (make-queue :priority-queue :compare (lambda (a b)
                                                                     (< (fourth a)
                                                                        (fourth b))))))
                       (qpush q (list (cons 0 0) :right 0 0 nil))
@@ -45,11 +61,11 @@
         with goal = (cons (1- (input-map-width map))
                           (1- (input-map-height map)))
         while (> (qsize todo) 0)
-        for (pos dir steps heat-loss history) = (qpop todo)
+        for (pos dir steps heat-loss) = (qpop todo)
         when (equal pos goal)
           do (return heat-loss)
         do (setf (gethash (list pos dir steps) closed) t)
-        do (loop for (next next-dir steps) in (next-steps map pos dir steps closed)
+        do (loop for (next next-dir steps) in (funcall next-steps map pos dir steps closed)
                  for cost = (char-number (map-cell map next))
                  for next-heat-cost = (+ heat-loss cost)
                  for existing = (queue-find todo (lambda (existing)
@@ -65,4 +81,9 @@
                              (nth 2 existing-value) steps
                              (nth 1 existing-value) next-dir))
                       ((null existing-value)
-                       (qpush todo (list next next-dir steps next-heat-cost (cons pos history))))))))
+                       (qpush todo (list next next-dir steps next-heat-cost)))))))
+
+(defun day-17 (input)
+  (let ((map (make-map input)))
+    (values (find-path-with-lowest-head-loss map #'next-steps-crucible)
+            (find-path-with-lowest-head-loss map #'next-steps-ultra-crucible))))
blob - 69b37d077a002083a45fe874593fa7fe0bedb42b
blob + cea9875edf37d4f4fda410891d36561f47df7383
--- t/day-17.lisp
+++ t/day-17.lisp
@@ -4,7 +4,7 @@
 
 (define-test test-day-17
     ()
-  (multiple-value-bind (task-1)
+  (multiple-value-bind (task-1 task-2)
       (aoc:run-day 17 "2413432311323
 3215453535623
 3255245654254
@@ -18,4 +18,5 @@
 1224686865563
 2546548887735
 4322674655533")
-    (assert= 102 task-1)))
+    (assert= 102 task-1)
+    (assert= 94 task-2)))