aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2023/day21/solver.lisp
blob: a120be04e563cc9d80bf542c502069e28f5e8cc1 (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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
(ql:quickload '(fiveam))
(defpackage :day21
  (:use :cl :fiveam))
(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 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)

      (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))
         (visited (make-hash-table :test #'equal))
         (start (find-start field)))
    (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.
            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))
                             (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)))

(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.
  ;; 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))

(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))))