blob: 7a77123d812d4ba7fd3748d9a8d6a8e76ea55d6b (
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
|
(ql:quickload '(:fiveam :uiop :arrows))
(defconstant +chamber-width+ 7)
(defun point (x y)
(+ x (* y +chamber-width+)))
(defun coords (point)
(floor point +chamber-width+))
(defparameter *rocks*
(vector (list (point 0 0) (point 1 0) (point 2 0) (point 3 0))
(list (point 1 0)
(point 0 1) (point 1 1) (point 2 1)
(point 1 2))
(list (point 0 0) (point 1 0) (point 2 0)
(point 2 1)
(point 2 2))
(list (point 0 0) (point 0 1) (point 0 2) (point 0 3))
(list (point 0 0) (point 1 0)
(point 0 1) (point 1 1))))
(defun no-collision-move (object direction obstacles)
(mapcar
(lambda (current)
(let ((next (funcall
(ecase direction
(#\> #'1+)
(#\< #'1-)
(#\v #'(lambda (p) (- p +chamber-width+))))
current)))
(if (and (>= next 0)
;; no rolling boundaries
(multiple-value-bind (y x) (coords current)
(multiple-value-bind (y2 x2) (coords next)
(= 1 (+ (abs (- x x2)) (abs (- y y2))))))
(not (member next obstacles :test #'eq)))
next (return-from no-collision-move object))))
object))
(fiveam:test moves
(fiveam:is (equal '(6) (no-collision-move '(6) #\v nil)))
(fiveam:is (equal '(6) (no-collision-move '(6) #\> nil)))
(fiveam:is (equal '(6) (no-collision-move '(6) #\< '(5)))))
(defun gen-object (seq)
(let ((len (length seq))
(index 0))
(lambda ()
(prog1 (aref seq index)
(setf index (mod (1+ index) len))))))
(defun place-rock (rock highpoint)
(let ((left-pad 2)
(altitude (* +chamber-width+ highpoint)))
(mapcar (lambda (point)
(+ point left-pad altitude))
rock)))
(defun next-move (rock next-move obstacles)
(let* ((shift (no-collision-move rock next-move obstacles))
(drop (no-collision-move shift #\v obstacles)))
(values drop (equal shift drop))))
(defun highpoint (obstacles)
(1+ (coords (reduce #'max obstacles))))
(defun simulate (chamber rock next-shift)
(multiple-value-bind (new-place done-falling-p)
(next-move rock (funcall next-shift) chamber)
(if done-falling-p
(values (append new-place chamber) (highpoint new-place))
(simulate chamber new-place next-shift))))
(defun solver (drops-left highpoint raise-history obstacles next-rock next-shift)
(if (zerop drops-left)
raise-history
(multiple-value-bind (new-obstacles posible-high)
(simulate obstacles
(place-rock (funcall next-rock) (+ highpoint 3))
next-shift)
(let ((new-high (max highpoint posible-high)))
(solver (1- drops-left) new-high (cons new-high raise-history)
;; new-obstacles
(if (zerop (mod drops-left 100)) ;; arbitrarily chop list
(subseq new-obstacles 0 (min 128 (length new-obstacles)))
new-obstacles)
next-rock next-shift)))))
(defun occurrences (lst)
(let ((table (make-hash-table :test #'eq)))
(loop for e in lst
do (incf (gethash e table 0)))
table))
(defun to-alist (table)
(loop for k being the hash-key of table using (hash-value v)
collect (cons k v)))
(defun find-period (history max-window)
(let ((len (1- (length history))))
(loop for size from 1 to max-window
for raises = (loop
for start from 0 to len by size
for end from size by size
collect (- (aref history (min end len)) (aref history start)))
for periods = (occurrences raises)
for test = (and (<= (hash-table-count periods) 3)
(car (find-if (lambda (f) (< 1 (cdr f))) (to-alist periods))))
until test
finally (return (values size test)))))
(defun height-reached (max-drops history max-window)
(multiple-value-bind (period block-height) (find-period history max-window)
(multiple-value-bind (cycles left) (floor max-drops period)
(let ((offset (aref history period))
(remaining (- (aref history (+ left period)) (aref history period))))
(+ offset (* (1- cycles) block-height) remaining)))))
(fiveam:test solutions
;; part 1
(fiveam:is
(= 3068 (car (solver 2022 0 '(0) nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in"))))))
(fiveam:is
(= 3141 (car (solver 2022 0 '(0) nil (gen-object *rocks*) (gen-object (uiop:read-file-line "input"))))))
;; part 2
(let* ((drops 1000000000000)
(quick-run 10000)
(max-period-window 3620)
(history-eg (nreverse (solver quick-run 0 '(0) nil (gen-object *rocks*)
(gen-object (uiop:read-file-line "eg-in")))))
(history-my (nreverse (solver quick-run 0 '(0) nil (gen-object *rocks*)
(gen-object (uiop:read-file-line "input"))))))
(fiveam:is (= 1514285714288
(height-reached drops (make-array (length history-eg) :initial-contents history-eg)
max-period-window)))
(fiveam:is (= 1561739130391
(height-reached drops (make-array (length history-my) :initial-contents history-my)
max-period-window)))))
|
