blob: e0ed16621a14e6d3eeb11a6f284fc0406e4c0041 (
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
|
(ql:quickload '(fiveam uiop str))
(defun bounds (walls)
(loop for (ym x1 x0) on (loop for line in walls
nconc (loop for (x y) in line
maximize y into ymax
maximize x into xmax
minimize x into xmin
finally (return (list ymax xmax xmin)))) by #'cdddr
maximize ym into ymax
maximize x1 into xmax
minimize x0 into xmin
finally (return (list ymax xmax xmin))))
(defstruct grid
bounds
x-len
y-len
grid)
(defun grid (bounds x-len y-len)
(make-grid :bounds bounds :x-len x-len :y-len y-len
:grid (make-array (* x-len y-len) :initial-element 0 :element-type '(unsigned-byte 2))))
(defun make-abyss-grid (bounds)
(let ((y-len (1+ (car bounds)))
(x-len (1+ (- (cadr bounds) (caddr bounds)))))
(grid bounds x-len y-len)))
(defun make-finite-grid (bounds)
(let* ((y-len (+ 3 (car bounds)))
(x-len (* 2 y-len)))
(setf (elt bounds 1) (+ 500 y-len))
(setf (elt bounds 2) (- 500 y-len))
(grid bounds x-len y-len)))
(defun solver-point (x y grid)
(let ((x (- x (caddr (grid-bounds grid)))))
(when (and (< -1 x (grid-x-len grid))
(< -1 y (grid-y-len grid)))
(+ x (* y (grid-x-len grid))))))
(defun paired-range (fx tx fy ty grid)
(destructuring-bind ((fx tx) (fy ty)) (list (sort (list fx tx) #'<) (sort (list fy ty) #'<))
(loop for l from (solver-point fx fy grid) to (solver-point tx ty grid) by (if (= fx tx) (grid-x-len grid) 1)
collect l)))
(defun place-wall (positions grid)
(loop for l in positions :do (setf (aref (grid-grid grid) l) 1)))
(defun solver--wall-line (grid walls)
(loop for line in walls
do (loop for ((fx fy) (tx ty)) on line until (null tx)
:do (place-wall (paired-range fx tx fy ty grid) grid))))
(defun draw-grid (grid)
(let ((out (make-string-output-stream)))
(loop for elt across (grid-grid grid)
for idx from 0
do (progn (when (= 0 (mod idx (grid-x-len grid))) (terpri out))
(princ (case elt
(0 ".")
(1 "#")
(2 "o")) out)))
(get-output-stream-string out)))
(defun simulate (grid)
(let ((drops 0)
(x 500) (y 0))
(flet ((check (dir)
(when (= 0 (aref (grid-grid grid)
(ecase dir
(forward (solver-point x (1+ y) grid))
(left (solver-point (1- x) (1+ y) grid))
(right (solver-point (1+ x) (1+ y) grid)))))
(incf y))))
(handler-case
(loop while
(cond
((check 'forward))
((check 'left) (decf x))
((check 'right) (incf x))
(t (setf (aref (grid-grid grid) (solver-point x y grid)) 2)
(incf drops)
(unless (= y 0)
(setf x 500 y 0)))))
(sb-int:invalid-array-index-error ()))
drops)))
(defun parse-location (list-str)
(mapcar (lambda (row)
(mapcar (lambda (pair)
(mapcar #'parse-integer (str:split "," pair)))
(str:split " -> " row)))
list-str))
(defun solver (list-str grid-constructor)
(let* ((walls (parse-location list-str))
(grid (funcall grid-constructor (bounds walls))))
(solver--wall-line grid walls)
(when (eq grid-constructor #'make-finite-grid)
(let ((b (grid-bounds grid)))
(place-wall
(paired-range (1- (elt b 1)) (elt b 2)
(1- (grid-y-len grid)) (1- (grid-y-len grid)) grid) grid)))
(values (simulate grid)
(draw-grid grid))))
(fiveam:test test
(let ((eg-data (uiop:split-string "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" :separator '(#\Newline))))
(fiveam:is (= 24 (solver eg-data #'make-abyss-grid)))
(fiveam:is (= 93 (solver eg-data #'make-finite-grid))))
(let ((in-data (uiop:read-file-lines "./input")))
(fiveam:is (= 665 (solver in-data #'make-abyss-grid)))
(fiveam:is (= 25434 (solver in-data #'make-finite-grid)))))
|
