aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/24
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2023-01-24 19:19:45 +0100
committerOscar Najera <hi@oscarnajera.com>2023-01-24 19:19:45 +0100
commit10292271a2a46f13849f7e1e2a27c33e2384b2de (patch)
treed7ad49859eaf81ad668b0d9eb9bdac7e0f6d2b28 /AoC2022/24
parent2bea07a804dde0fe90a26b9dc725d9d289ec338a (diff)
downloadscratch-10292271a2a46f13849f7e1e2a27c33e2384b2de.tar.gz
scratch-10292271a2a46f13849f7e1e2a27c33e2384b2de.tar.bz2
scratch-10292271a2a46f13849f7e1e2a27c33e2384b2de.zip
Clean up, heretic use of mutation
Diffstat (limited to 'AoC2022/24')
-rw-r--r--AoC2022/24/solver.lisp125
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))))