blob: bb32e0f1e25885933d587ccd1f87b22e2928adbc (
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
|
(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 solver-finite-grid (bounds)
(let* ((y-len (+ 3 (car bounds)))
(x-len (* 2 y-len)))
(setf (car bounds) (+ 500 y-len))
(setf (elt bounds 1) (- 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 solver--wall-line (grid walls)
(loop for line in walls
do (loop for ((startx starty) (fx fy)) on line until (null fx)
:if (= startx fx)
:do (loop for y from (min starty fy) to (max starty fy)
:do (setf (aref (grid-grid grid) (solver-point startx y grid)) 1))
:else
:do (loop for x from (min startx fx) to (max startx fx)
:do (setf (aref (grid-grid grid) (solver-point x starty grid)) 1)))))
(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))
(loop while
(ignore-errors ;; went out of grid
(cond
((= 0 (aref (grid-grid grid) (solver-point x (1+ y) grid)))
(incf y)) ;; check next
((= 0 (aref (grid-grid grid) (solver-point (1- x) (1+ y) grid)))
(incf y)
(decf x)) ;; check left
((= 0 (aref (grid-grid grid) (solver-point (1+ x) (1+ y) grid)))
(incf y)
(incf x)) ;; check right
(t (setf (aref (grid-grid grid) (solver-point x y grid)) 2)
(incf drops)
(unless (= y 0)
(setf x 500 y 0))))))
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)
(let* ((walls (parse-location list-str))
(grid (make-abyss-grid (bounds walls))))
(solver--wall-line grid walls)
(list (simulate grid)
(draw-grid grid))))
(solver (uiop:split-string "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" :separator '(#\Newline)))
(solver (uiop:read-file-lines #P"./input"))
|
