diff options
Diffstat (limited to 'AoC2022/17/solver.lisp')
| -rw-r--r-- | AoC2022/17/solver.lisp | 96 |
1 files changed, 67 insertions, 29 deletions
diff --git a/AoC2022/17/solver.lisp b/AoC2022/17/solver.lisp index 0be6c02..bad968a 100644 --- a/AoC2022/17/solver.lisp +++ b/AoC2022/17/solver.lisp @@ -1,12 +1,14 @@ (ql:quickload '(:fiveam :uiop :arrows)) -(defparameter *chamber-width* 7) +(defconstant +chamber-width+ (the fixnum 7)) (defun point (x y) - (+ x (* y *chamber-width*))) + (+ x (* y +chamber-width+))) (defun coords (point) - (floor point *chamber-width*)) + (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)) @@ -22,9 +24,10 @@ (defun left (point) (1- point)) (defun right (point) (1+ point)) -(defun down (point) (- point *chamber-width*)) +(defun down (point) (- point +chamber-width+)) (defun no-collision-move (object direction obstacles) + (declare (optimize (speed 3))) (mapcar (lambda (current) (let ((next (funcall @@ -34,14 +37,21 @@ (#\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)))) + (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)) @@ -50,36 +60,51 @@ (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))) + (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 (chamber next-move rock) - (let* ((shift (advance chamber next-move rock)) - (drop (advance chamber #\v shift))) +(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 chamber (funcall next-shift) rock) + (next-move rock (funcall next-shift) chamber) (if done-falling-p - (append new-place chamber) + (values (append new-place chamber) (highpoint new-place)) (simulate chamber new-place next-shift)))) -(defun highpoint (obstacles) - (1+ (coords (reduce #'max obstacles)))) (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) - (let ((obstacles (simulate obstacles - (place-rock (funcall next-rock) (+ highpoint 3)) - next-shift))) - (solver (1- drops-left) (highpoint obstacles) obstacles next-rock next-shift)))) + ;; (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 @@ -88,3 +113,16 @@ (= 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)) |