diff options
| -rw-r--r-- | AoC2022/14/solver.lisp | 102 |
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")) |