From 5c57053cda2d5e3ee88d6c146ae6d00026014fc1 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Fri, 16 Dec 2022 21:25:06 +0100
Subject: CL simpler functions more code

---
 AoC2022/14/solver.lisp | 63 ++++++++++++++++++++++++++++----------------------
 1 file changed, 36 insertions(+), 27 deletions(-)

(limited to 'AoC2022')

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
-- 
cgit v1.2.3