aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2024-01-12 03:16:15 +0100
committerOscar Najera <hi@oscarnajera.com>2024-01-12 03:16:15 +0100
commit90602579fb543a15b689de5b6bcc2ad41ad47c04 (patch)
treeabef55b866bafbee4a5572792ebd1975217d254a
parent115f577bddb4ec0186a7b0306dbcd53d0b877df8 (diff)
downloadscratch-90602579fb543a15b689de5b6bcc2ad41ad47c04.tar.gz
scratch-90602579fb543a15b689de5b6bcc2ad41ad47c04.tar.bz2
scratch-90602579fb543a15b689de5b6bcc2ad41ad47c04.zip
refactoring
-rw-r--r--AoC2023/day21/solver.lisp110
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)))))