diff options
Diffstat (limited to 'AoC2023/day21')
| -rw-r--r-- | AoC2023/day21/solver.lisp | 110 |
1 files changed, 47 insertions, 63 deletions
diff --git a/AoC2023/day21/solver.lisp b/AoC2023/day21/solver.lisp index a120be0..4253569 100644 --- a/AoC2023/day21/solver.lisp +++ b/AoC2023/day21/solver.lisp @@ -1,6 +1,6 @@ (ql:quickload '(fiveam)) (defpackage :day21 - (:use :cl :fiveam)) + (:use :cl :fiveam :alexandria)) (in-package :day21) ;;22:55 ;;23:32 @@ -13,51 +13,20 @@ (when (eq (aref field row col) #\S) (return-from find-start (list row col))))))) -(defun solver1 (lines step-count) - (let* ((field (make-array (list (length lines) (length (car lines))) - :initial-contents lines)) - pending - (end-positions (make-hash-table :test #'equal)) - (visited (make-hash-table :test #'equal)) - (start (find-start field))) - (destructuring-bind (rows cols) - (array-dimensions field) +(defun read-field (filename) + (let* ((lines (uiop:read-file-lines filename))) + (make-array (list (length lines) (length (car lines))) + :initial-contents lines))) - (push (cons step-count start) pending) - (setf (gethash start visited) step-count) - - (loop while pending - for (steps-left row col) = (pop pending) - ;; an even number of steps left means it is possible - ;; to go and return to the place in the steps available - ;; Thus count to the solution. - when (evenp steps-left) - do (setf (gethash (list row col) end-positions) t) - unless (zerop steps-left) - do (loop - for (dr dc) in '((-1 0) (0 -1) (1 0) (0 1)) - for nr = (+ row dr) - for nc = (+ col dc) - for new-pos = (list nr nc) - when (and (< (gethash new-pos visited -1) (1- steps-left)) - (< -1 nr rows) - (< -1 nc cols) - (not (eq #\# (aref field nr nc)))) - do (setf (gethash new-pos visited) (1- steps-left)) - (push (cons (1- steps-left) new-pos) pending)))) - (hash-table-count end-positions))) - -(test solutions - (is (= 16 (solver1 (uiop:read-file-lines "eg-in") 6))) - (is (= 3574 (solver1 (uiop:read-file-lines "input") 64)))) - -(defun solver2 (lines step-count) - (let* ((field (make-array (list (length lines) (length (car lines))) - :initial-contents lines)) - pending - (end-positions (make-hash-table :test #'equal)) +(defun solver (field boundedp &rest step-counts) + (let* (pending (visited (make-hash-table :test #'equal)) - (start (find-start field))) + (start (find-start field)) + (step-count (car (last step-counts))) + (end-positions (mapcar (lambda (s) + (cons (- step-count s) + (make-hash-table :test #'equal))) + step-counts))) (destructuring-bind (rows cols) (array-dimensions field) @@ -69,8 +38,13 @@ ;; an even number of steps left means it is possible ;; to go and return to the place in the steps available ;; Thus count to the solution. - when (evenp steps-left) - do (setf (gethash (list row col) end-positions) t) + do + (dolist (ep end-positions) + (destructuring-bind (check-point . tracker) ep + (let ((mark-left (- steps-left check-point))) + (when (and (not (minusp mark-left)) + (evenp mark-left)) + (setf (gethash (list row col) tracker) t))))) unless (zerop steps-left) do (loop for (dr dc) in '((-1 0) (0 -1) (1 0) (0 1)) @@ -78,22 +52,16 @@ for nc = (+ col dc) for new-pos = (list nr nc) when (and (< (gethash new-pos visited -1) (1- steps-left)) + (if boundedp + (and + (< -1 nr rows) + (< -1 nc cols)) + t) (not (eq #\# (aref field (mod nr rows) (mod nc cols))))) do (setf (gethash new-pos visited) (1- steps-left)) (push (cons (1- steps-left) new-pos) pending)))) - (hash-table-count end-positions))) + (mapcar (compose #'hash-table-count #'cdr) end-positions))) -(solver2 (uiop:read-file-lines "eg-in") 6) -(solver2 (uiop:read-file-lines "eg-in") 10) -(solver2 (uiop:read-file-lines "eg-in") 50) -(solver2 (uiop:read-file-lines "eg-in") 100) -;; (time (solver2 (uiop:read-file-lines "eg-in") 500)) - -(defun solve-part2 () - (let ((x 202300)) - (multiple-value-bind (a b c) - (solve-quadratic 3719 33190 91987) - (+ (* a x x) (* b x) c)))) (defun solve-quadratic (r-one r-two r-three) ;; The covered area grows proportional to the square of steps taken. @@ -114,8 +82,24 @@ (/ (- (* 4 r-two) (* 3 r-one) r-three) 2) r-one)) -(test sols - (loop for steps in (list 65 (+ 65 131) (+ 65 (* 131 2))) - for result in '(3719 33190 91987) - do (is (= result (solver2 (uiop:read-file-lines "input") steps)))) - (is (= 600090522932119 (solve-part2)))) +(defun solve-part2 (places) + (let ((x 202300)) + (multiple-value-bind (a b c) + (apply #'solve-quadratic places) + (+ (* a x x) (* b x) c)))) + +(test solutions + (is (= 16 (car (solver (read-field "eg-in") t 6)))) + (is (= 3574 (car (solver (read-field "input") t 64)))) + (mapc (lambda (solution calculated) + (is (= solution calculated))) + '(16 50 1594 6536 26538 59895) + (solver (read-field "eg-in") nil 6 10 50 100 200 300)) + + (let ((results '(3719 33190 91987)) + (places (solver (read-field "input") nil 65 (+ 65 131) (+ 65 (* 131 2))))) + (mapc (lambda (solution calculated) + (is (= solution calculated))) + results + places) + (is (= 600090522932119 (solve-part2 results))))) |