From 10292271a2a46f13849f7e1e2a27c33e2384b2de Mon Sep 17 00:00:00 2001 From: Oscar Najera Date: Tue, 24 Jan 2023 19:19:45 +0100 Subject: Clean up, heretic use of mutation --- AoC2022/24/solver.lisp | 125 +++++++++++++++++++++++++++---------------------- 1 file changed, 68 insertions(+), 57 deletions(-) (limited to 'AoC2022') 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)))) -- cgit v1.2.3