blob: dffadf7cfa50b2f5203c55d0fd14ae5b02662f41 (
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
|
;; 9:39 start
;; 10:17 part 1
;; 13:23 part 2
(ql:quickload '(fiveam))
(defun roll (direction row col)
(ecase direction
(north (list (1- row) col))
(south (list (1+ row) col))
(west (list row (1- col)))
(east (list row (1+ col)))))
(defun edges-run (field direction)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(list
(alexandria:iota maxrow :start (if (eq direction 'south) (1- maxrow) 0)
:step (if (eq direction 'south) -1 1))
(alexandria:iota maxcol :start (if (eq direction 'east) (1- maxcol) 0)
:step (if (eq direction 'east) -1 1)))))
(defun in-bounds (field row col)
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(and (< -1 row maxrow)
(< -1 col maxcol))))
(defun roll-rocks (field direction)
(destructuring-bind (rows cols) (edges-run field direction)
(loop for i in rows do
(loop for j in cols do
(loop
for (row col) = (list i j) then (list new-row new-col)
for (new-row new-col) = (roll direction row col)
while (and
(in-bounds field new-row new-col)
(eq #\O (aref field row col))
(eq #\. (aref field new-row new-col)))
do (setf (aref field new-row new-col) #\O
(aref field row col) #\.))))))
(defun array-slice (arr row)
(make-array (array-dimension arr 1)
:displaced-to arr
:displaced-index-offset (* row (array-dimension arr 1))))
(defun north-load (field)
(loop
with rows = (array-dimension field 0)
for row below rows
sum (* (- rows row) (count #\O (array-slice field row)))))
(defun solve1 (input)
(let* ((rows (length input))
(field
(make-array (list rows (length (car input))) :initial-contents input)))
(roll-rocks field 'north)
(north-load field)))
(defun draw-field (field &optional (out *standard-output*))
(destructuring-bind (maxrow maxcol) (array-dimensions field)
(loop for i below maxrow do
(loop for j below maxcol do
(write-char (aref field i j) out))
(terpri out))
(terpri out)))
(defun find-series (list)
(let* ((len (length list))
(half-length (floor len 2)))
(loop for span from 1 below half-length
when (equal
(subseq list (- len span) len)
(subseq list (- len (* span 2)) (- len span)))
do (return span))))
(defun spin (field iters)
(loop
do (dolist (dir '(north west south east))
(roll-rocks field dir))
repeat iters
collect
(north-load field)))
(defun solve2 (input max-cycles)
(let* ((rows (length input))
(field
(make-array (list rows (length (car input))) :initial-contents input)))
(destructuring-bind (start series ls)
(loop
for cycle = 5 then (* 2 cycle)
append (spin field cycle) into serie
do
(alexandria:when-let ((has-serie (find-series serie)))
(return
(list (- (length serie) has-serie)
(subseq serie (- (length serie) has-serie))
has-serie))))
(elt series (1- (rem (- max-cycles start) ls))))))
(fiveam:test solutions
(fiveam:is (= 136 (solve1 (uiop:read-file-lines "eg-in"))))
(fiveam:is (= 108935 (solve1 (uiop:read-file-lines "input"))))
(fiveam:is (= 64 (solve2 (uiop:read-file-lines "eg-in") 1000000000)))
(fiveam:is (= 100876(solve2 (uiop:read-file-lines "input") 1000000000))))
|
