1(defpackage #:advent.2024.08
2 (:use #:cl #:advent.2024.00)
3 (:import-from #:alexandria
4 #:maphash-values
5 #:map-permutations))
6(in-package #:advent.2024.08)
7
8;;; Part 1.
9;; How many locations in the map contain "antinodes" ?
10;; Hmmmm let's do a hash-table
11
12;; COORDINATES are stored in (row . col)
13
14(defparameter *input* "08.ex")
15
16(defun radio-map ()
17 "Return a hash map of frequency => (list station-coordinates)."
18 (let ((res (make-hash-table)))
19 (loop for row from 0
20 for line in (uiop:read-file-lines *input*) do
21 (loop for col from 0
22 for char across line
23 do (incf col)
24 do (unless (eq char #\.)
25 (push (cons row col) (gethash char res))))
26 finally (return res))))
27
28(defun find-pair-antinodes (pair)
29 "Given a COORD-PAIR, find its antinodes."
30 (destructuring-bind ((row1 . col1) (row2 . col2)) pair
31 (let ((rise (- row2 row1))
32 (run (- col2 col1)))
33 ;; m a t h h h h h h h h h h h h h
34 (list (cons (- row1 rise)
35 (- col1 run))
36 (cons (+ row2 rise)
37 (+ col2 run))))))
38
39;; (defun find-antinodes* (coordinates)
40;; "Find all the antinodes of each pair of stations in COORDINATES."
41;; (let (res)
42;; (alexandria:map-permutations (lambda (pair)
43;; (setf res
44;; (append (find-pair-antinodes pair)
45;; res)))
46;; coordinates
47;; :length 2)
48;; res))
49
50(defun unique-values (list)
51 (let (unique)
52 (loop for coord in list
53 unless (member coord unique :test #'equal)
54 do (push coord unique)
55 finally (return unique))))
56
57;; (defun solve1* ()
58;; ;;; ACTUALLY this returns the list of antinodes... do (length (solve1)) to get
59;; ;;; the answer.
60;; (let* ((lines (uiop:read-file-lines *input*))
61;; (rows (length lines))
62;; (cols (length (car lines)))
63;; res)
64;; (alexandria:maphash-values (lambda (v)
65;; (setf res (append
66;; (remove-if-not
67;; (lambda (p)
68;; (and (< -1 (car p) rows)
69;; (< -1 (cdr p) cols)))
70;; (find-antinodes v))
71;; res)))
72;; (radio-map))
73;; res))
74
75;;; Part 2
76;; Extend the antinode idea to the edge of the map
77
78(defun insidep (point rows cols)
79 "Is POINT inside the map?"
80 (and (< -1 (car point) rows)
81 (< -1 (cdr point) cols)))
82
83(defun find-pair-resonants (pair rows cols)
84 "Find the resonants along the line of P1-P2."
85 (destructuring-bind ((row1 . col1) (row2 . col2)) pair
86 (let ((rise (- row2 row1))
87 (run (- col2 col1)))
88 ;; MATH!
89 (append pair
90 (loop for r = (- row1 rise) then (- r rise)
91 for c = (- col1 run) then (- c run)
92 while (insidep (cons r c) rows cols)
93 collect (cons r c)
94 )
95 (loop for r = (+ row2 rise) then (+ r rise)
96 for c = (+ col2 run) then (+ c run)
97 while (insidep (cons r c) rows cols)
98 collect (cons r c)
99 )))))
100
101;; (defun solve2* ()
102;; (let* ((lines (uiop:read-file-lines *input*))
103;; (rows (length lines))
104;; (cols (length (car lines)))
105;; res)
106;; (alexandria:maphash-values
107;; (lambda (v)
108;; (setf res (append (find-all #'find-pair-resonants v rows cols) res)))
109;; (radio-map))
110;; (unique-values res)))
111
112;;; 435 too low --- I forgot to add the 2 originals
113;;; 585 too low
114;;; 628 too low ---- 435 + 193 (number of original radios)
115
116
117;;; Doing this again....
118;; I was trying to figure out part 2, and then part 1 isn't giving the right
119;; solution either. So let's do it again.
120
121;;; Part 1.
122
123(defvar *rows* nil)
124(defvar *cols* nil)
125
126(defun field ()
127 (let ((res (make-hash-table))
128 (lines (uiop:read-file-lines *input*)))
129 (setf *rows* (length lines))
130 (setf *cols* (length (car lines)))
131 (loop for line in lines
132 for row from 0 do
133 (loop for char across line
134 for col from 0 do
135 (unless (eq char #\.)
136 (push (cons row col) (gethash char res))))
137 finally (return res))))
138
139(defun find-antinodes (pair)
140 (destructuring-bind ((row1 . col1) (row2 . col2)) pair
141 (let ((drow (- row2 row1))
142 (dcol (- col2 col1)))
143 (list (cons (- row1 drow)
144 (- col1 dcol))
145 (cons (+ row2 drow)
146 (+ col2 dcol))))))
147
148(defun outsidep (point)
149 (unless (and *rows* *cols*)
150 (field))
151 (or (> 0 (car point))
152 (> 0 (cdr point))
153 (<= *rows* (car point))
154 (<= *cols* (cdr point))))
155
156(defun find-group-antinodes (list &optional (fn #'find-antinodes))
157 "For every pair in LIST, find every pair of antinodes."
158 (let (res)
159 (map-permutations (lambda (pair)
160 ;; (print pair)
161 (loop for pt in (funcall fn pair)
162 ;; do (print pt)
163 do (pushnew pt res :test #'equal)))
164 list
165 :length 2)
166 (remove-if #'outsidep res)))
167
168(defun solve1 ()
169 (let (res)
170 (maphash-values (lambda (coordinate-group)
171 (loop for g in (find-group-antinodes coordinate-group) do
172 (pushnew g res :test #'equal)))
173 (field))
174 (length res)))
175
176;;; OKAY THIS IS CORRECT! DOPE.
177
178;;; Part 2.
179
180(defun find-resonant-antinodes (pair)
181 (destructuring-bind ((row1 . col1) (row2 . col2)) pair
182 (let ((drow (- row2 row1))
183 (dcol (- col2 col1)))
184 (append pair
185 (loop for r = (- row1 drow) then (- r drow)
186 for c = (- col1 dcol) then (- c dcol)
187 until (outsidep (cons r c))
188 collect (cons r c))
189 (loop for r = (+ row2 drow) then (+ r drow)
190 for c = (+ col2 dcol) then (+ c dcol)
191 until (outsidep (cons r c))
192 collect (cons r c))))))
193
194(defun solve2 ()
195 (let (res)
196 (maphash-values (lambda (group)
197 (loop for g in (find-group-antinodes
198 group #'find-resonant-antinodes)
199 do (pushnew g res :test #'equal)))
200 (field))
201 (length (remove-if #'outsidep res))))
202
203;;; YAY!