blob: c28c1ca4fcd59dbd7c8378f059dd62fa7e0b6327 (
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
|
;;8:57
;;10:26 part1
;;10:53 part2
(ql:quickload '(fiveam arrows alexandria))
(defstruct ray
dir row col)
(defun in-bounds (field ray)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(with-slots (row col) ray
(and (< -1 row maxrow)
(< -1 col maxcol)))))
(defun next-direction (ray)
(with-slots (dir row col) ray
(ecase dir
(up (decf row))
(lf (decf col))
(dw (incf row))
(rt (incf col))))
ray)
(defun mirror-bs (ray)
(with-slots (dir row col) ray
(arrows:->>
(ecase dir
(up 'lf)
(lf 'up)
(dw 'rt)
(rt 'dw))
(setf dir)))
ray)
(defun mirror-fs (ray)
(with-slots (dir row col) ray
(arrows:->>
(ecase dir
(up 'rt)
(rt 'up)
(lf 'dw)
(dw 'lf))
(setf dir)))
ray)
(defun split (ray alignment)
(with-slots (dir row col) ray
(mapcar (lambda (d) (make-ray :dir d :row row :col col))
(cond
((and (eq alignment 'vertical) (member dir '(lf rt))) '(up dw))
((and (eq alignment 'horizontal) (member dir '(up dw))) '(lf rt))
((list dir))))))
(defun energized-p (energized ray)
(with-slots (dir row col) ray
(find dir (gethash (cons row col) energized))))
(defun ensure-list (l) (if (listp l) l (list l)))
(defun action (field ray energized)
(with-slots (dir row col) ray
(arrows:->>
(ecase (aref field row col)
(#\. ray)
(#\\ (mirror-bs ray))
(#\/ (mirror-fs ray))
(#\| (split ray 'vertical))
(#\- (split ray 'horizontal)))
(ensure-list)
(mapcar #'next-direction)
(remove-if-not (alexandria:curry #'in-bounds field))
(remove-if (alexandria:curry #'energized-p energized)))))
(defun advancer (field rays energized)
(dolist (r rays)
(with-slots (dir row col) r
(push dir (gethash (cons row col) energized))))
(if (null rays)
energized
(let ((next-moves (mapcan (lambda (ray) (action field ray energized)) rays)))
;; (format t "~d Next: ~a~%" maxi next-moves)
(advancer field next-moves energized))))
(defun boundary-rays (field)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(mapcar (lambda (point)
(destructuring-bind (dir row col) point
(make-ray :dir dir :row row :col col)))
(append
(loop for i below maxrow collect (list 'rt i 0))
(loop for i below maxrow collect (list 'lf i (1- maxcol)))
(loop for i below maxcol collect (list 'dw 0 i))
(loop for i below maxcol collect (list 'up (1- maxrow) i))))))
(defun solver (field)
(lambda (start)
(hash-table-count
(advancer field (list start)
(make-hash-table :test #'equal)))))
(defun solution (input &optional (starter (constantly (list (make-ray :dir 'rt :row 0 :col 0)))))
(let* ((rows (length input))
(field
(make-array (list rows (length (car input))) :initial-contents input)))
(reduce #'max (funcall starter field) :key (solver field))))
(fiveam:test solutions
(fiveam:is (= 46 (solution (uiop:read-file-lines "eg-in"))))
(fiveam:is (= 7996 (solution (uiop:read-file-lines "input"))))
(fiveam:is (= 51 (solution (uiop:read-file-lines "eg-in") #'boundary-rays)))
(fiveam:is (= 8239 (solution (uiop:read-file-lines "input") #'boundary-rays))))
|
