aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/15/solver.lisp
blob: 9a93e1fe6c7b43adfa8f8fc5ad24bb1f998c1300 (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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
(ql:quickload '(fiveam str cl-ppcre arrows uiop))



(defun bounds (markers)
  (list (list
         (loop for (x . y) in markers minimize x)
         (loop for (x . y) in markers maximize x))
        (list
         (loop for (x . y) in markers minimize y)
         (loop for (x . y) in markers maximize y))))

(defun grid (bounds)
  (destructuring-bind ((xmin xmax) (ymin ymax)) bounds
    (make-array (* (- xmax xmin -1) (- ymax ymin -1)) :initial-element 0 :element-type '(unsigned-byte 2))))

(defun in-grid (bounds)
  (destructuring-bind ((xmin xmax) (ymin ymax)) bounds
    (let ((stride (- xmax xmin -1)))
      (lambda (x y)
        (when (and (<= xmin x xmax) (<= ymin y ymax))
          (+ (- x xmin) (* (- y ymin) stride)))))))

(defun from-grid (bounds)
  (destructuring-bind ((xmin xmax) (ymin _)) bounds
    (declare (ignore _))
    (let ((stride (- xmax xmin -1)))
      (lambda (pos)
        (multiple-value-bind (y x) (floor pos stride)
          (cons (+ x xmin) (+ y ymin)))))))

(defun draw-grid (grid stride)
  (let ((out (make-string-output-stream)))
    (loop for elt across grid
          for idx from 0
          do (progn (when (= 0 (mod idx stride)) (terpri out))
                    (princ (case elt
                             (0 ".")
                             (1 "S")
                             (2 "B")
                             (3 "#")) out)))
    (get-output-stream-string out)))

(defun manhattan-dist (pos-sensor pos-beacon)
  (destructuring-bind ((sx . sy) (bx . by)) (list pos-sensor pos-beacon)
    (+ (abs (- bx sx)) (abs (- by sy)))))

(defun markers (lines)
  (loop for line in lines
        for (sx sy bx by) = (multiple-value-bind (match values)
                                (cl-ppcre:scan-to-strings "Sensor at x=(-?\\d+), y=\(-?\\d+\): closest beacon is at x=(-?\\d+), y=(-?\\d+)"
                                                          line)
                                (declare (ignore match))
                              (map 'list #'parse-integer values))
        nconc (list (cons sx sy) (cons bx by))))


(let* ((lines (uiop:read-file-lines "eg-in"))
       (markers (markers lines))
       (bounds (bounds markers))
       (loc (in-grid bounds))
       (grid (grid bounds))
       (coords (from-grid bounds)))
  (loop for ((sx . sy) (bx . by)) on markers by #'cddr
        do (progn (setf (aref grid (funcall loc sx sy)) 1)
                  (setf (aref grid (funcall loc bx by)) 2)))

  (loop for (sensor beacon) on markers by #'cddr
        for distance = (manhattan-dist sensor beacon)
        do (loop
             for elt across grid
             and l from 0
             when (and (<= (manhattan-dist sensor (funcall coords l)) distance) (= elt 0))
               do (setf (aref grid l) 3)))

  (destructuring-bind ((xmin xmax) (ymin ymax)) bounds
    (let ((stride (- xmax xmin -1)))
      (princ (draw-grid grid stride))
      (loop repeat stride
            for l from (* (+ 10 ymin) stride)
            when (= 3 (aref grid l))
              count it))))

(defun count-cover (markers target-row)
  (let ((bounds (bounds markers))
        (max-distance (loop for (sensor beacon) on markers by #'cddr
                            maximize (manhattan-dist sensor beacon))))

    (destructuring-bind ((xmin xmax) ys) bounds
      (declare (ignore ys))
      (let* ((stride (- (+ (* 2 max-distance) xmax 1) xmin))
             (row-min (- xmin max-distance))
             (row (make-array stride :element-type '(unsigned-byte 1) :initial-element 0)))
        (loop for (sensor beacon) on markers by #'cddr
              for distance = (manhattan-dist sensor beacon)
              when (= target-row (cdr sensor))
                do (setf (aref row (- (car sensor) row-min)) 1)
              when (= target-row (cdr beacon))
                do (setf (aref row (- (car beacon) row-min)) 1)

              sum (loop
                    for x from (- xmin distance) to (+ xmax distance)
                    when (and (<= (manhattan-dist sensor (cons x target-row)) distance)
                              (< -1 (- x row-min) stride)
                              (= 0 (aref row (- x row-min))))
                      count it and do (setf (aref row (- x row-min)) 1)))))))

(count-cover (markers (uiop:read-file-lines "eg-in")) 10)
(count-cover (markers (uiop:read-file-lines "input")) 2000000)

;; fail coverage
(defun fail-freq (markers bound)
  (loop :for y from 0 to bound
        :for col = (loop :for x from 0 to bound
                         :when (loop :for (sensor beacon) on markers by #'cddr
                                     :never (<= (manhattan-dist sensor (cons x y))
                                                (manhattan-dist sensor beacon)))
                           :return x)
        :when col
          :return (+ (* 4000000 col) y)))

(fail-freq (markers (uiop:read-file-lines "eg-in")) 20)
(fail-freq (markers (uiop:read-file-lines "input")) 4000000)

(let* ((markers )
       (bound 20)))


(let* ((lines (uiop:read-file-lines "input"))
       (markers (markers lines))
       (bounds (bounds markers)))
  bounds)

(make-array (* 4000000 4000000) :element-type '(unsigned-byte 1) :initial-element 0)