blob: 3471b3b6ed4e87da525c63d75c79d9b78c2ca1ed (
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
122
123
124
125
126
|
(ql:quickload '(fiveam str cl-ppcre arrows uiop))
(defun bounds (markers)
(list (list
(loop for (x . y) in markers minimize x)
(loop for (x . y) in markers maximize x))
(list
(loop for (x . y) in markers minimize y)
(loop for (x . y) in markers maximize y))))
(defun grid (bounds)
(destructuring-bind ((xmin xmax) (ymin ymax)) bounds
(make-array (* (- xmax xmin -1) (- ymax ymin -1)) :initial-element 0 :element-type '(unsigned-byte 2))))
(defun in-grid (bounds)
(destructuring-bind ((xmin xmax) (ymin ymax)) bounds
(let ((stride (- xmax xmin -1)))
(lambda (x y)
(when (and (<= xmin x xmax) (<= ymin y ymax))
(+ (- x xmin) (* (- y ymin) stride)))))))
(defun from-grid (bounds)
(destructuring-bind ((xmin xmax) (ymin _)) bounds
(declare (ignore _))
(let ((stride (- xmax xmin -1)))
(lambda (pos)
(multiple-value-bind (y x) (floor pos stride)
(cons (+ x xmin) (+ y ymin)))))))
(defun draw-grid (grid stride)
(let ((out (make-string-output-stream)))
(loop for elt across grid
for idx from 0
do (progn (when (= 0 (mod idx stride)) (terpri out))
(princ (case elt
(0 ".")
(1 "S")
(2 "B")
(3 "#")) out)))
(get-output-stream-string out)))
(defun manhattan-dist (pos-sensor pos-beacon)
(destructuring-bind ((sx . sy) (bx . by)) (list pos-sensor pos-beacon)
(+ (abs (- bx sx)) (abs (- by sy)))))
(defun markers (lines)
(loop for line in lines
for (sx sy bx by) = (multiple-value-bind (match values)
(cl-ppcre:scan-to-strings "Sensor at x=(-?\\d+), y=\(-?\\d+\): closest beacon is at x=(-?\\d+), y=(-?\\d+)"
line)
(declare (ignore match))
(map 'list #'parse-integer values))
nconc (list (cons sx sy) (cons bx by))))
(let* ((lines (uiop:read-file-lines "eg-in"))
(markers (markers lines))
(bounds (bounds markers))
(loc (in-grid bounds))
(grid (grid bounds))
(coords (from-grid bounds)))
(loop for ((sx . sy) (bx . by)) on markers by #'cddr
do (progn (setf (aref grid (funcall loc sx sy)) 1)
(setf (aref grid (funcall loc bx by)) 2)))
(loop for (sensor beacon) on markers by #'cddr
for distance = (manhattan-dist sensor beacon)
do (loop
for elt across grid
and l from 0
when (and (<= (manhattan-dist sensor (funcall coords l)) distance) (= elt 0))
do (setf (aref grid l) 3)))
(destructuring-bind ((xmin xmax) (ymin ymax)) bounds
(let ((stride (- xmax xmin -1)))
(princ (draw-grid grid stride))
(loop repeat stride
for l from (* (+ 10 ymin) stride)
when (= 3 (aref grid l))
count it))))
(defun count-cover (markers target-row)
(let ((bounds (bounds markers))
(max-distance (loop for (sensor beacon) on markers by #'cddr
maximize (manhattan-dist sensor beacon))))
(destructuring-bind ((xmin xmax) ys) bounds
(declare (ignore ys))
(loop with y = target-row
for x from (- xmin max-distance) to (+ xmax max-distance)
:count (loop for (sensor beacon) on markers by #'cddr
:thereis (and (not (equal beacon (cons x y)))
(not (equal sensor (cons x y)))
(<= (manhattan-dist sensor (cons x y))
(manhattan-dist sensor beacon))))))))
(count-cover (markers (uiop:read-file-lines "eg-in")) 10)
(count-cover (markers (uiop:read-file-lines "input")) 2000000)
;; fail coverage
(defun fail-freq (markers bound)
(loop :for y from 0 to bound
:for col = (loop :for x from 0 to bound
:when (loop :for (sensor beacon) on markers by #'cddr
:never (<= (manhattan-dist sensor (cons x y))
(manhattan-dist sensor beacon)))
:return x)
:when col
:return (+ (* 4000000 col) y)))
(fail-freq (markers (uiop:read-file-lines "eg-in")) 20)
(fail-freq (markers (uiop:read-file-lines "input")) 4000000)
(let* ((markers )
(bound 20)))
(let* ((lines (uiop:read-file-lines "input"))
(markers (markers lines))
(bounds (bounds markers)))
bounds)
(make-array (* 4000000 4000000) :element-type '(unsigned-byte 1) :initial-element 0)
|