(ql:quickload '(fiveam cl-ppcre uiop arrows))

;; Actual problem
(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))))

(defun sensor-coverage (markers)
  (loop for (sensor beacon) on markers by #'cddr
        collect (list sensor (manhattan-dist sensor beacon))))

(defun beacons-in-row (markers row)
  (loop for (s (bx . by)) on markers by #'cddr
        when (and (= row by) (not (member bx seenx)))
          count by and collect bx into seenx))

(defun sensor-intervals-on-row (coverages target-row)
  (sort
   (loop for ((sx . sy) range) in coverages
         for span = (- range (abs (- sy target-row)))
         when (> span 0)
           collect (list (- sx span) (+ sx span)))
   #'< :key #'car))

(defun overlap-p (a b)
  "Test if b=[b0;b1] overlaps a=[a0;a1]"
  (destructuring-bind (a0 a1) a
    (destructuring-bind (b0 b1) b
      (and (<= a0 b1) (<= b0 a1)))))

(defun merge-intervals (a b)
  "For overlapping interval a & b get full range"
  (assert (overlap-p a b))
  (destructuring-bind (a0 a1) a
    (destructuring-bind (b0 b1) b
      (list (min a0 b0) (max a1 b1)))))

(defun interval-accumulator (result interval)
  (cond
    ((numberp (car result))
     (list (merge-intervals result interval)))
    ((overlap-p (car result) interval)
     (cons (merge-intervals (car result) interval)
           (cdr result)))
    (t (cons (car result) (cons interval (cdr result))))))

(defun interval-length (a)
  (destructuring-bind (a0 a1) a
    (1+ (- a1 a0))))

(defun measure-cover (markers target-row)
  (arrows:-<> (sensor-coverage markers)
              (sensor-intervals-on-row <> target-row)
              (reduce #'interval-accumulator <>)
              (reduce #'+ <> :key #'interval-length)
              (- <> (beacons-in-row markers target-row))))

;; solution part 1
(fiveam:test part1
  (fiveam:is (= 26 (measure-cover (markers (uiop:read-file-lines "eg-in")) 10)))
  (fiveam:is (= 5040643 (measure-cover (markers (uiop:read-file-lines "input")) 2000000))))


(defun coverage-edge (sensor coverage low high test)
  (destructuring-bind (x . y) sensor
    (let ((edge (1+ coverage)))
      (loop named dangling
            for cx from (max low (- x edge)) to (min high (+ x edge))
            for available = (- edge (abs (- x cx)))
            :do (loop for cy in (list  (- y available) (+ y available))
                      :when (and (<= low cy high)
                                 (not (funcall test (cons cx cy))))
                        :do (return-from dangling (list cx cy)))))))

(defun point-covered (sensor-coverage)
  (lambda (point)
    (loop for (other-sensor range) in sensor-coverage
          :thereis (<= (manhattan-dist point other-sensor) range))))

;; fail coverage too slow
(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)))

(defun fail-freq-edge (markers low high)
  (let* ((sensor-coverage (sensor-coverage markers))
         (covered-p (point-covered sensor-coverage)))
    (loop for (sensor coverage)  in sensor-coverage
          :when (coverage-edge sensor coverage low high covered-p)
            :return it)))

(defun tune-soluton (position)
  (destructuring-bind (x y) position
    (+ (* x 4000000) y)))

(fiveam:test part2
    (fiveam:is (= 56000011 (tune-soluton (fail-freq-edge (markers (uiop:read-file-lines "eg-in")) 0 20))))
  (fiveam:is (= 11016575214126 (tune-soluton (fail-freq-edge (markers (uiop:read-file-lines "input")) 2700000 3300000)))))

(fiveam:run-all-tests)
;; Obsolete drawing
(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 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 draw-example-coverage ()
  (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
      (declare (ignore ymax))
      (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)))))