day 15 redo part 1 for speed

1 files changed, 43 insertions, 21 deletions

diff --git a/AoC2022/15/solver.lisp b/AoC2022/15/solver.lisp
index 25bf982..a22efd4 100644
--- a/AoC2022/15/solver.lisp
+++ b/AoC2022/15/solver.lisp
@@ -1,4 +1,4 @@
-(ql:quickload '(fiveam cl-ppcre uiop))
+(ql:quickload '(fiveam cl-ppcre uiop arrows))
 
 ;; Actual problem
 (defun manhattan-dist (pos-sensor pos-beacon)
@@ -18,34 +18,56 @@
   (loop for (sensor beacon) on markers by #'cddr
         collect (list sensor (manhattan-dist sensor beacon))))
 
-(defun sensor-range-on-row (coverages target-row)
-  (loop for ((sx . sy) range) in coverages
-        for span = (- range (abs (- sy target-row)))
-        when (> span 0)
-          maximize (+ sx span) into right
-          and minimize (- sx span) into left
-        finally (return (list left right))))
-
 (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 count-cover (markers target-row)
-  (let ((coverages (sensor-coverage markers)))
-    (destructuring-bind (xmin xmax) (sensor-range-on-row coverages target-row)
-      (- (loop with y = target-row
-               for x from xmin to xmax
-               :count (loop for ((sx . sy) range) in coverages
-                            :thereis (and (not (and (= x sx) (= y sy)))
-                                          (<= (manhattan-dist (cons sx sy) (cons x y))
-                                              range))))
-         (beacons-in-row markers target-row)))))
+(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 (count-cover (markers (uiop:read-file-lines "eg-in")) 10)))
-  (fiveam:is (= 5040643 (count-cover (markers (uiop:read-file-lines "input")) 2000000))))
+  (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)