aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--AoC2022/17/solver.lisp44
1 files changed, 14 insertions, 30 deletions
diff --git a/AoC2022/17/solver.lisp b/AoC2022/17/solver.lisp
index 90a8b0c..ecabf98 100644
--- a/AoC2022/17/solver.lisp
+++ b/AoC2022/17/solver.lisp
@@ -1,13 +1,11 @@
(ql:quickload '(:fiveam :uiop :arrows))
-(defconstant +chamber-width+ (the fixnum 7))
+(defconstant +chamber-width+ 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*
@@ -27,7 +25,6 @@
(defun down (point) (- point +chamber-width+))
(defun no-collision-move (object direction obstacles)
- (declare (optimize (speed 3)))
(mapcar
(lambda (current)
(let ((next (funcall
@@ -37,11 +34,9 @@
(#\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)))))
@@ -60,14 +55,11 @@
(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)))
+ (+ point left-pad altitude))
+ rock)))
(defun next-move (rock next-move obstacles)
(let* ((shift (no-collision-move rock next-move obstacles))
@@ -78,8 +70,6 @@
(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
@@ -88,17 +78,13 @@
(defun solver (drops-left highpoint raise-history obstacles next-rock next-shift)
- (declare (optimize (speed 3)))
- (declare (type fixnum drops-left highpoint))
- (declare (type function next-rock))
(if (zerop drops-left)
raise-history
;; highpoint
(multiple-value-bind (new-obstacles posible-high)
(simulate obstacles
- (place-rock (funcall next-rock) (the fixnum (+ highpoint 3)))
+ (place-rock (funcall next-rock) (+ highpoint 3))
next-shift)
- (declare (type fixnum posible-high))
(let ((new-high (max highpoint posible-high)))
(solver (1- drops-left) new-high (cons new-high raise-history)
;; new-obstacles
@@ -120,21 +106,19 @@
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))
- ;; collect (reduce #'+ (subseq history start (min end len)))
- )
+ collect (- (aref history (min end len)) (aref history start)))
for periods = (occurrences raises)
- until (<= (length periods) 3)
- finally (return (values size periods)))))
+ for test = (and (<= (length periods) 3)
+ (car (find-if (lambda (f) (< 1 (cdr f))) periods)))
+ until test
+ finally (return (values size test)))))
(defun height-reached (max-drops history max-window)
- (multiple-value-bind (period frequencies) (find-period history max-window)
- (destructuring-bind (block-height . _) (find-if (lambda (f) (< 1 (cdr f))) frequencies)
- (declare (ignore _))
- (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))))))
+ (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