blob: 4253569a662951b79565caed05a702e59d7cae21 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
(ql:quickload '(fiveam))
(defpackage :day21
(:use :cl :fiveam :alexandria))
(in-package :day21)
;;22:55
;;23:32
(defun find-start (field)
(destructuring-bind (rows cols)
(array-dimensions field)
(loop for row below rows do
(loop for col below cols do
(when (eq (aref field row col) #\S)
(return-from find-start (list row col)))))))
(defun read-field (filename)
(let* ((lines (uiop:read-file-lines filename)))
(make-array (list (length lines) (length (car lines)))
:initial-contents lines)))
(defun solver (field boundedp &rest step-counts)
(let* (pending
(visited (make-hash-table :test #'equal))
(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)
(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.
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))
for nr = (+ row dr)
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))))
(mapcar (compose #'hash-table-count #'cdr) end-positions)))
(defun solve-quadratic (r-one r-two r-three)
;; The covered area grows proportional to the square of steps taken.
;; The requested numbers of steps (= 26501365 (+ (* 202300 131) 65))
;; The function that takes to the the edge of the field g(x) = 65 + x * 131
;; The standard quadratic function q(x) = a*x^2 + b*x + c
;; r₁ = q o g (0) = c
;; r₂ = q o g (1) = a + b + c
;; r₃ = q o g (2) = 4a + 2b + c
;;
;; solving is simple
;; a = (r₃ - 2r₂ + r₁) / 2
;; b = (4r₂ - 3r₁ - r₃) / 2
;; c = r₁
(values (/ (+ (- r-three (* 2 r-two))
r-one)
2)
(/ (- (* 4 r-two) (* 3 r-one) r-three) 2)
r-one))
(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)))))
|
