aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2022-12-16 21:25:06 +0100
committerOscar Najera <hi@oscarnajera.com>2022-12-16 21:25:06 +0100
commit5c57053cda2d5e3ee88d6c146ae6d00026014fc1 (patch)
tree857cf4fd628712bb9675baa0bde1de1733b91370
parent869cca94ef24afeff03b6582c8ac3a522cc866e2 (diff)
downloadscratch-5c57053cda2d5e3ee88d6c146ae6d00026014fc1.tar.gz
scratch-5c57053cda2d5e3ee88d6c146ae6d00026014fc1.tar.bz2
scratch-5c57053cda2d5e3ee88d6c146ae6d00026014fc1.zip
CL simpler functions more code
-rw-r--r--AoC2022/14/solver.lisp63
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