aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2022-12-16 19:01:39 +0100
committerOscar Najera <hi@oscarnajera.com>2022-12-16 19:13:14 +0100
commit6a6bd6563c6a4fc5c9d018da773bef29d26f4b76 (patch)
tree988df3ded3eefec9fab8a45e328af18b903048d5
parentda3f2069e60f73fc6c6399537d8fb4b50cbf223c (diff)
downloadscratch-6a6bd6563c6a4fc5c9d018da773bef29d26f4b76.tar.gz
scratch-6a6bd6563c6a4fc5c9d018da773bef29d26f4b76.tar.bz2
scratch-6a6bd6563c6a4fc5c9d018da773bef29d26f4b76.zip
Common lisp
-rw-r--r--AoC2022/14/solver.lisp102
1 files changed, 102 insertions, 0 deletions
diff --git a/AoC2022/14/solver.lisp b/AoC2022/14/solver.lisp
new file mode 100644
index 0000000..bb32e0f
--- /dev/null
+++ b/AoC2022/14/solver.lisp
@@ -0,0 +1,102 @@
+(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))))
+
+(defstruct grid
+ bounds
+ x-len
+ y-len
+ grid)
+
+(defun grid (bounds x-len y-len)
+ (make-grid :bounds bounds :x-len x-len :y-len y-len
+ :grid (make-array (* x-len y-len) :initial-element 0 :element-type '(unsigned-byte 2))))
+
+(defun make-abyss-grid (bounds)
+ (let ((y-len (1+ (car bounds)))
+ (x-len (1+ (- (cadr bounds) (caddr bounds)))))
+ (grid bounds x-len y-len)))
+
+(defun solver-finite-grid (bounds)
+ (let* ((y-len (+ 3 (car bounds)))
+ (x-len (* 2 y-len)))
+ (setf (car bounds) (+ 500 y-len))
+ (setf (elt bounds 1) (- 500 y-len))
+ (grid bounds x-len y-len)))
+
+(defun solver-point (x y grid)
+ (let ((x (- x (caddr (grid-bounds grid)))))
+ (when (and (< -1 x (grid-x-len grid))
+ (< -1 y (grid-y-len grid)))
+ (+ x (* y (grid-x-len grid))))))
+
+(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)))))
+
+(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
+ (0 ".")
+ (1 "#")
+ (2 "o")) out)))
+ (get-output-stream-string out)))
+
+(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))
+
+(defun parse-location (list-str)
+ (mapcar (lambda (row)
+ (mapcar (lambda (pair)
+ (mapcar #'parse-integer (str:split "," pair)))
+ (str:split " -> " row)))
+ list-str))
+
+(defun solver (list-str)
+ (let* ((walls (parse-location list-str))
+ (grid (make-abyss-grid (bounds walls))))
+ (solver--wall-line grid walls)
+ (list (simulate grid)
+ (draw-grid grid))))
+
+(solver (uiop:split-string "498,4 -> 498,6 -> 496,6
+503,4 -> 502,4 -> 502,9 -> 494,9" :separator '(#\Newline)))
+
+(solver (uiop:read-file-lines #P"./input"))