diff options
Diffstat (limited to 'AoC2022/14')
| -rw-r--r-- | AoC2022/14/solver.lisp | 63 |
1 files changed, 36 insertions, 27 deletions
diff --git a/AoC2022/14/solver.lisp b/AoC2022/14/solver.lisp index 188824b..0a2af57 100644 --- a/AoC2022/14/solver.lisp +++ b/AoC2022/14/solver.lisp @@ -41,15 +41,19 @@ (< -1 y (grid-y-len grid))) (+ x (* y (grid-x-len grid)))))) +(defun paired-range (fx tx fy ty grid) + (destructuring-bind ((fx tx) (fy ty)) (list (sort (list fx tx) #'<) (sort (list fy ty) #'<)) + (loop for l from (solver-point fx fy grid) to (solver-point tx ty grid) by (if (= fx tx) (grid-x-len grid) 1) + collect l))) + + +(defun place-wall (positions grid) + (loop for l in positions :do (setf (aref (grid-grid grid) l) 1))) + (defun solver--wall-line (grid walls) (loop for line in walls - do (loop for ((startx starty) (fx fy)) on line until (null fx) - :if (= startx fx) - :do (loop for y from (min starty fy) to (max starty fy) - :do (setf (aref (grid-grid grid) (solver-point startx y grid)) 1)) - :else - :do (loop for x from (min startx fx) to (max startx fx) - :do (setf (aref (grid-grid grid) (solver-point x starty grid)) 1))))) + do (loop for ((fx fy) (tx ty)) on line until (null tx) + :do (place-wall (paired-range fx tx fy ty grid) grid)))) (defun draw-grid (grid) (let ((out (make-string-output-stream))) @@ -65,22 +69,26 @@ (defun simulate (grid) (let ((drops 0) (x 500) (y 0)) - (loop while - (ignore-errors ;; went out of grid - (cond - ((= 0 (aref (grid-grid grid) (solver-point x (1+ y) grid))) - (incf y)) ;; check next - ((= 0 (aref (grid-grid grid) (solver-point (1- x) (1+ y) grid))) - (incf y) - (decf x)) ;; check left - ((= 0 (aref (grid-grid grid) (solver-point (1+ x) (1+ y) grid))) - (incf y) - (incf x)) ;; check right - (t (setf (aref (grid-grid grid) (solver-point x y grid)) 2) - (incf drops) - (unless (= y 0) - (setf x 500 y 0)))))) - drops)) + (flet ((check (dir) + (when (= 0 (aref (grid-grid grid) + (ecase dir + (forward (solver-point x (1+ y) grid)) + (left (solver-point (1- x) (1+ y) grid)) + (right (solver-point (1+ x) (1+ y) grid))))) + (incf y)))) + (handler-case + (loop while + (cond + ((check 'forward)) + ((check 'left) (decf x)) + ((check 'right) (incf x)) + (t (setf (aref (grid-grid grid) (solver-point x y grid)) 2) + (incf drops) + (unless (= y 0) + (setf x 500 y 0))))) + (sb-int:invalid-array-index-error ())) + + drops))) (defun parse-location (list-str) (mapcar (lambda (row) @@ -94,11 +102,12 @@ (grid (funcall grid-constructor (bounds walls)))) (solver--wall-line grid walls) (when (eq grid-constructor #'make-finite-grid) - (loop with yrow = (* (grid-x-len grid) (1- (grid-y-len grid))) - for x from 0 below (grid-x-len grid) - do (setf (aref (grid-grid grid) (+ x yrow)) 1))) + (let ((b (grid-bounds grid))) + (place-wall + (paired-range (1- (elt b 1)) (elt b 2) + (1- (grid-y-len grid)) (1- (grid-y-len grid)) grid) grid))) (values (simulate grid) - (draw-grid grid)))) + (draw-grid grid)))) (fiveam:test test (let ((eg-data (uiop:split-string "498,4 -> 498,6 -> 496,6 |