blob: 950752eb9ffee05339650057bf6e40a32af0d1a1 (
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
127
128
129
130
131
|
;;05:32
(ql:quickload '(fiveam arrows))
(defparameter directions
'((up -1 0)
(dw 1 0)
(lf 0 -1)
(rt 0 1)))
(defparameter pipes
'((#\| up dw)
(#\- lf rt)
(#\L up rt)
(#\J up lf)
(#\7 dw lf)
(#\F dw rt)
(#\.)
(#\S up dw lf rt)))
(defparameter eg-input
"7-F7-
.FJ|7
SJLL7
|F--J
LJ.LJ")
(defun get-neighbors (point)
(mapcar
(lambda (dir)
(cdr (assoc dir directions)))
(cdr (assoc point pipes))))
(fiveam:test parts
(fiveam:is (equal '((0 -1) (0 1))
(get-neighbors #\-))))
(defun find-start (map)
(loop for row across map
for y from 0 do
(loop for col across row
for x from 0
when (eq #\S col)
do (return-from find-start (list y x)))))
(defun move-next (map point)
(flet ((bounds (y x)
(let ((ymax (length map))
(xmax (length (aref map 0))))
(when (and (< -1 y ymax)
(< -1 x xmax))
(list y x)))))
(destructuring-bind (y x) point
(loop for (dy dx) in (get-neighbors (aref (aref map y) x))
when (bounds (+ y dy) (+ x dx)) collect it))))
(defun start-neighbors (map start)
(remove-if-not
(lambda (n)
(member start (move-next map n) :test #'equal))
(move-next map start)))
(defun advance-next (map point last)
(let ((next (move-next map point)))
(if (equal last (car next))
(cadr next)
(car next))))
(defun get-loop (map)
(let* ((start (find-start map))
(options (start-neighbors map start))
(last start)
(cur (car options))
(loop-tiles (make-hash-table :test #'equal)))
(setf (gethash cur loop-tiles) t)
(loop
for next = (advance-next map cur last)
do (setf last cur
cur next
(gethash next loop-tiles) t)
until (equal next start))
loop-tiles))
(defun solver1 (rows)
(let ((map (make-array (length rows) :initial-contents rows)))
(floor (hash-table-count (get-loop map)) 2)))
;; To know if a point is inside a loop, I need to count how often a ray crosses
;; until it reaches the boundary. I can just count to the right.
;; In this case only the vertical edges count, and element that change direction.
;; Meaning LJ is a u, same as F7 an n, that means the ray passes tangent across
;; those 2 cells taking the point a bit lower, would mean only counting pipes
;; with down component thus F,|,7. The rest L,-,J are irrelevant.
(defun rassoc-get (list item)
(car (rassoc item list :test #'equal)))
(defun correct-start (map)
(let ((start (find-start map)))
(arrows:->> (start-neighbors map start)
(mapcar (lambda (point)
(destructuring-bind (y x) point
(list (- y (first start))
(- x (second start))))))
(mapcar (lambda (p) (rassoc-get directions p)))
(rassoc-get pipes)
(setf (aref (aref map (car start)) (cadr start))))))
(defun solver2 (rows)
(let* ((map (make-array (length rows) :initial-contents rows))
(loop-tiles (get-loop map))
insidep)
(correct-start map)
(loop for row across map
for y from 0
for insidep = nil
sum
(loop for col across row
for x from 0
for point = (list y x)
if (gethash point loop-tiles) do
(when (member col '(#\F #\| #\7))
(setf insidep (not insidep)))
else count insidep))))
(fiveam:test solution
(fiveam:is (= 8 (solver1 (uiop:split-string eg-input :separator '(#\Newline)))))
(fiveam:is (= 6812 (solver1 (uiop:read-file-lines "input"))))
(fiveam:is (= 1 (solver2 (uiop:split-string eg-input :separator '(#\Newline)))))
(fiveam:is (= 527 (solver2 (uiop:read-file-lines "input")))))
|
