blob: 0be6c02ccab6d5d78304dae345a85de3c28be217 (
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
|
(ql:quickload '(:fiveam :uiop :arrows))
(defparameter *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 left (point) (1- point))
(defun right (point) (1+ point))
(defun down (point) (- point *chamber-width*))
(defun no-collision-move (object direction obstacles)
(mapcar
(lambda (current)
(let ((next (funcall
(ecase direction
(#\> #'right)
(#\< #'left)
(#\v #'down))
current)))
(multiple-value-bind (y2 x2) (coords next)
(and (>= y2 0)
;; no rolling boundaries
(multiple-value-bind (y x) (coords current)
(= 1 (+ (abs (- x x2)) (abs (- y y2)))))
(not (member next obstacles :test #'=))
next))))
object))
(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))
(mapcar (lambda (point) (+ point left-pad (* *chamber-width* highpoint))) rock)))
(defun advance (chamber next-move rock)
(let ((next-place (no-collision-move rock next-move chamber)))
(if (every #'integerp next-place)
next-place rock)))
(defun next-move (chamber next-move rock)
(let* ((shift (advance chamber next-move rock))
(drop (advance chamber #\v shift)))
(values drop (equal shift drop))))
(defun simulate (chamber rock next-shift)
(multiple-value-bind (new-place done-falling-p)
(next-move chamber (funcall next-shift) rock)
(if done-falling-p
(append new-place chamber)
(simulate chamber new-place next-shift))))
(defun highpoint (obstacles)
(1+ (coords (reduce #'max obstacles))))
(defun solver (drops-left highpoint obstacles next-rock next-shift)
(if (zerop drops-left)
(values highpoint obstacles)
(let ((obstacles (simulate obstacles
(place-rock (funcall next-rock) (+ highpoint 3))
next-shift)))
(solver (1- drops-left) (highpoint obstacles) 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"))))
|
