aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/14/solver.lisp
blob: 8454cea08e037a004af58c8d40fe5ecb6b91c801 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
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)))))