blob: d93617a68c883f9ce5a01b7264ab5b7fe1c40a59 (
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
132
133
134
135
|
;;05:32
(ql:quickload '(fiveam))
(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)))
(cons cur
(loop
for next = (advance-next map cur last)
do (setf last cur
cur next)
collect next
until (equal next start)))))
;; (get-loop
;; (uiop:split-string eg-input :separator '(#\Newline)))
(defun solver1 (rows)
(let ((map (make-array (length rows) :initial-contents rows)))
(floor (length (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 in-loop-p (point loop)
(member point loop :test #'equal))
(defun rassoc-get (item list)
(car (rassoc item list :test #'equal)))
(defun correct-start (map)
(let ((start (find-start map)))
(setf (aref (aref map (car start)) (cadr start))
(rassoc-get
(loop for (y x) in (start-neighbors map start)
collect
(rassoc-get (list (- y (first start))
(- x (second start)))
directions))
pipes))))
(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 do
(setf insidep nil)
sum
(loop for col across row
for x from 0
for point = (list y x)
when (and (in-loop-p point loop-tiles)
(member col '(#\F #\| #\7)))
do (setf insidep (not insidep))
count (and (not (in-loop-p point loop-tiles))
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")))))
|
