diff options
| -rw-r--r-- | AoC2022/17/solver.lisp | 44 |
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 |