blob: bad968a434bfc024ac8161c8e432b4aab2e47e37 (
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
|
(ql:quickload '(:fiveam :uiop :arrows))
(defconstant +chamber-width+ (the fixnum 7))
(defun point (x y)
(+ x (* y +chamber-width+)))
(defun coords (point)
(declare (optimize (speed 3)))
(declare (type fixnum 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 left (point) (1- point))
(defun right (point) (1+ point))
(defun down (point) (- point +chamber-width+))
(defun no-collision-move (object direction obstacles)
(declare (optimize (speed 3)))
(mapcar
(lambda (current)
(let ((next (funcall
(ecase direction
(#\> #'right)
(#\< #'left)
(#\v #'down))
current)))
(multiple-value-bind (y2 x2) (coords next)
(declare (type fixnum y2 x2))
(if (and (>= y2 0)
;; no rolling boundaries
(multiple-value-bind (y x) (coords current)
(declare (type fixnum y x))
(= 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)
(declare (optimize (speed 3)))
(declare (type fixnum highpoint))
(let ((left-pad 2)
(altitude (* +chamber-width+ highpoint)))
(declare (type fixnum altitude))
(mapcar (lambda (point)
(declare (type fixnum point))
(the fixnum (+ 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)
(declare (optimize (speed 3)))
(declare (type function 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 obstacles next-rock next-shift)
(declare (optimize (speed 3)))
(declare (type fixnum drops-left highpoint))
(declare (type function next-rock))
(if (zerop drops-left)
;; (values highpoint obstacles)
highpoint
(multiple-value-bind (new-obstacles posible-high)
(simulate obstacles
(place-rock (funcall next-rock) (the fixnum (+ highpoint 3)))
next-shift)
(declare (type fixnum posible-high))
(solver (1- drops-left) (max highpoint posible-high)
(if (zerop (mod drops-left 100)) ;; arbitrarily chop list
(subseq new-obstacles 0 (min 128 (length new-obstacles)))
new-obstacles)
next-rock next-shift))))
(fiveam:test solutions
(fiveam:is
(= 3068 (solver 2022 0 nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in")))))
(fiveam:is
(= 3141 (solver 2022 0 nil (gen-object *rocks*) (gen-object (uiop:read-file-line "input"))))))
;; (print (solver 1000000000000 0 nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in"))))
(time (solver 40000 0 nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in"))))
;; (require :sb-sprof)
;; (sb-sprof::start-profiling)
;; (sb-sprof:report :type :flat)
;; (let ((a (make-array 5 :fill-pointer 0 :adjustable t)))
;; (vector-push-extend 2 a)
;; (vector-push-extend 6 a)
;; (vector-push-extend 8 a)
;; ;; (vector-push-extend 2 a)
;; ;; (vector-push-extend 6 a)
;; ;; (vector-push-extend 5 a)
;; (vector-push-extend 5 a))
|
