aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/21/input
diff options
context:
space:
mode:
authorOscar Najera <hi@oscarnajera.com>2025-02-10 02:08:51 +0100
committerOscar Najera <hi@oscarnajera.com>2025-02-10 02:08:51 +0100
commit0967597ff39c925bd746223b994922e632a0c98e (patch)
treeb732389062227b84aedce0d5044cd4d68c9ceb1d /AoC2022/21/input
parent7b90ec0b14a0114f055a26e2f29f92a3f771c87e (diff)
downloadscratch-0967597ff39c925bd746223b994922e632a0c98e.tar.gz
scratch-0967597ff39c925bd746223b994922e632a0c98e.tar.bz2
scratch-0967597ff39c925bd746223b994922e632a0c98e.zip
stats for separate domains
Diffstat (limited to 'AoC2022/21/input')
0 files changed, 0 insertions, 0 deletions
'>117 118
(ql:quickload '(fiveam uiop str))

(defun bounds (walls)
  (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
  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 make-finite-grid (bounds)
  (let* ((y-len (+ 3 (car bounds)))
         (x-len (* 2 y-len)))
    (setf (elt bounds 1) (+ 500 y-len))
    (setf (elt bounds 2) (- 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 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)
          :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 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 (ecase elt
                             (0 ".")
                             (1 "#")
                             (2 "o")) out)))
    (get-output-stream-string out)))

(defun simulate (grid)
  (let ((drops 0)
        (x 500) (y 0))
    (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-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 #'parse-coordinates list-str))

(defun solver (list-str grid-constructor)
  (let* ((walls (parse-location list-str))
         (grid (funcall grid-constructor (bounds walls))))
    (solver--wall-line grid walls)
    (when (eq grid-constructor #'make-finite-grid)
      (let ((b (grid-bounds grid)))
        (place-wall 
         (1- (elt b 1)) (elt b 2)
         (1- (grid-y-len grid)) (1- (grid-y-len grid))
         grid)))
    (values (simulate grid)
            (draw-grid grid))))

(fiveam:test test
  (let ((eg-data (uiop:split-string "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9" :separator '(#\Newline))))
    (fiveam:is (= 24 (solver eg-data #'make-abyss-grid)))
    (fiveam:is (= 93 (solver eg-data #'make-finite-grid))))

  (let ((in-data (uiop:read-file-lines "./input")))
    (fiveam:is (= 665 (solver in-data #'make-abyss-grid)))
    (fiveam:is (= 25434 (solver in-data #'make-finite-grid)))))