From bf91d82cfd0172e1a78dbec7db6a09259c3cfacb Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 12 Feb 2023 16:52:53 +0100
Subject: cleanup

---
 AoC2022/14/solver.lisp | 49 +++++++++++++++++++++++--------------------------
 1 file changed, 23 insertions(+), 26 deletions(-)

(limited to 'AoC2022/14/solver.lisp')

diff --git a/AoC2022/14/solver.lisp b/AoC2022/14/solver.lisp
index e0ed166..8454cea 100644
--- a/AoC2022/14/solver.lisp
+++ b/AoC2022/14/solver.lisp
@@ -1,17 +1,15 @@
 (ql:quickload '(fiveam uiop str))
 
 (defun bounds (walls)
-  (loop for (ym x1 x0) on (loop for line in walls
-                                nconc (loop for (x y) in line
-                                            maximize y into ymax
-                                            maximize x into xmax
-                                            minimize x into xmin
-                                            finally (return (list ymax xmax xmin)))) by #'cdddr
-
-        maximize ym into ymax
-        maximize x1 into xmax
-        minimize x0 into xmin
-        finally (return (list ymax xmax xmin))))
+  (let ((ymax most-negative-fixnum)
+        (xmax most-negative-fixnum)
+        (xmin most-positive-fixnum))
+    (loop for line in walls
+          do (loop for (x y) in line
+                   do (setf ymax (max y ymax))
+                      (setf xmax (max x xmax))
+                      (setf xmin (min x xmin))))
+    (list ymax xmax xmin)))
 
 (defstruct grid
   bounds
@@ -41,26 +39,22 @@
                (< -1 y (grid-y-len grid)))
       (+ x (* y (grid-x-len grid))))))
 
-(defun paired-range (fx tx fy ty grid)
+(defun place-wall (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)))
+          :do (setf (aref (grid-grid grid) l) 1))))
 
 (defun solver--wall-line (grid walls)
   (loop for line in walls
         do (loop for ((fx fy) (tx ty)) on line until (null tx)
-                 :do (place-wall (paired-range fx tx fy ty grid) grid))))
+                 :do (place-wall fx tx fy ty grid))))
 
 (defun draw-grid (grid)
   (let ((out (make-string-output-stream)))
     (loop for elt across (grid-grid grid)
           for idx from 0
           do (progn (when (= 0 (mod idx (grid-x-len grid))) (terpri out))
-                    (princ (case elt
+                    (princ (ecase elt
                              (0 ".")
                              (1 "#")
                              (2 "o")) out)))
@@ -90,12 +84,14 @@
 
       drops)))
 
+(defun parse-coordinates (coord)
+  (let (result)
+    (cl-ppcre:do-register-groups ((#'parse-integer x y)) ("(\\d+),(\\d+)" coord)
+      (push (list x y) result))
+    (nreverse result)))
+
 (defun parse-location (list-str)
-  (mapcar (lambda (row)
-            (mapcar (lambda (pair)
-                      (mapcar #'parse-integer (str:split "," pair)))
-                    (str:split " -> " row)))
-          list-str))
+  (mapcar #'parse-coordinates list-str))
 
 (defun solver (list-str grid-constructor)
   (let* ((walls (parse-location list-str))
@@ -104,8 +100,9 @@
     (when (eq grid-constructor #'make-finite-grid)
       (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)))
+         (1- (elt b 1)) (elt b 2)
+         (1- (grid-y-len grid)) (1- (grid-y-len grid))
+         grid)))
     (values (simulate grid)
             (draw-grid grid))))
 
-- 
cgit v1.2.3