blob: fcc1eed977203171b8fe5b13d73edcf6bf54808c (
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
|
;;05:32
(ql:quickload '(fiveam))
(defparameter directions
'((up 0 -1)
(dw 0 1)
(lf -1 0)
(rt 1 0)))
(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 '((-1 0) (1 0))
(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 (dx dy) 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 solver1 (rows)
(let* ((map (make-array (length rows) :initial-contents rows))
(start (find-start map))
(options (start-neighbors map start))
(last start)
(cur (car options))
)
(loop
for next = (advance-next map cur last)
for steps from 1
until (equal next start)
do (setf last cur
cur next)
finally (return (floor (+ steps 1) 2)))))
(fiveam:test solution
(fiveam:is (= 8 (solver1 (uiop:split-string eg-input :separator '(#\Newline)))))
(fiveam:is (= 6812 (solver1 (uiop:read-file-lines "input")))))
|
