commit 66456ba8fb5ceb69ad7ea2f2c8fcc757a6b6e405
parent 2b9c8dd94c27169b528d83a00011cc6f90e4a151
Author: Lukas Henkel <lh@entf.net>
Date: Sun, 17 Dec 2023 08:00:40 +0100
Day 17 task 2
Diffstat:
2 files changed, 38 insertions(+), 16 deletions(-)
diff --git a/src/day-17.lisp b/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))))
diff --git a/t/day-17.lisp b/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)))
