[AoC2022] Common LISP day 15 fast enough solution

2 files changed, 119 insertions, 143 deletions

diff --git a/AoC2022/15/input b/AoC2022/15/input
new file mode 100644
index 0000000..dff1409
--- /dev/null
+++ b/AoC2022/15/input
@@ -0,0 +1,24 @@
+Sensor at x=2924811, y=3544081: closest beacon is at x=3281893, y=3687621
+Sensor at x=2719183, y=2520103: closest beacon is at x=2872326, y=2415450
+Sensor at x=3754787, y=3322726: closest beacon is at x=3281893, y=3687621
+Sensor at x=1727202, y=1485124: closest beacon is at x=1329230, y=1133797
+Sensor at x=2517008, y=2991710: closest beacon is at x=2454257, y=2594911
+Sensor at x=1472321, y=3123671: closest beacon is at x=2216279, y=3414523
+Sensor at x=3456453, y=3959037: closest beacon is at x=3281893, y=3687621
+Sensor at x=3997648, y=2624215: closest beacon is at x=4401794, y=2000000
+Sensor at x=463281, y=967584: closest beacon is at x=1329230, y=1133797
+Sensor at x=2395529, y=1897869: closest beacon is at x=2454257, y=2594911
+Sensor at x=3094466, y=3888307: closest beacon is at x=3281893, y=3687621
+Sensor at x=2737812, y=3928154: closest beacon is at x=2744537, y=4159197
+Sensor at x=813538, y=3874308: closest beacon is at x=2216279, y=3414523
+Sensor at x=822358, y=1997263: closest beacon is at x=1329230, y=1133797
+Sensor at x=3993754, y=3951321: closest beacon is at x=3281893, y=3687621
+Sensor at x=2585409, y=3541887: closest beacon is at x=2216279, y=3414523
+Sensor at x=3269796, y=3730504: closest beacon is at x=3281893, y=3687621
+Sensor at x=3075750, y=2873879: closest beacon is at x=2872326, y=2415450
+Sensor at x=1357, y=2747918: closest beacon is at x=-1077481, y=3057204
+Sensor at x=2256257, y=344800: closest beacon is at x=1854450, y=-900998
+Sensor at x=2779742, y=2308087: closest beacon is at x=2872326, y=2415450
+Sensor at x=867692, y=64146: closest beacon is at x=1329230, y=1133797
+Sensor at x=3454465, y=966419: closest beacon is at x=4401794, y=2000000
+Sensor at x=1902550, y=2398376: closest beacon is at x=2454257, y=2594911
diff --git a/AoC2022/15/solver.lisp b/AoC2022/15/solver.lisp
index 3f35476..25bf982 100644
--- a/AoC2022/15/solver.lisp
+++ b/AoC2022/15/solver.lisp
@@ -1,37 +1,4 @@
-(ql:quickload '(fiveam str cl-ppcre arrows uiop iterate))
-(use-package :iterate)
-
-;; 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)))
+(ql:quickload '(fiveam cl-ppcre uiop))
 
 ;; Actual problem
 (defun manhattan-dist (pos-sensor pos-beacon)
@@ -66,7 +33,7 @@
 
 (defun count-cover (markers target-row)
   (let ((coverages (sensor-coverage markers)))
-    (destructuring-bind (xmin xmax) (sensor-range-on-row coverages  target-row)
+    (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
@@ -76,81 +43,28 @@
          (beacons-in-row markers target-row)))))
 
 ;; solution part 1
-(count-cover (markers (uiop:read-file-lines "eg-in")) 10)
-(count-cover (markers (uiop:read-file-lines "input")) 2000000)
-
-
-(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))))
-
-(arrows:->
- (markers (uiop:read-file-lines "eg-in"))
- (beacons-in-row 16)
- ;; (delete-duplicates :key #'car)
- ;; (sensor-coverage)
- ;; (sensor-range-on-row 10)
- )
-
-
-(defun overlap (a0 a1 b0 b1)
-  "Test if [b0;b1] overlaps [a0;a1]"
-  (and (<= a0 b1) (<= b0 a1)))
-
-(set-)
-
-(loop with intervals = nil
-      for ((sx . sy) beacon) on markers by #'cddr
-      for cover = (max 0 (- (manhattan-dist sensor beacon) (abs (- sy 11))))
-
-      do (let ((l (- sx cover))
-               (r (+ sx cover)))
-           (cond
-             ((some (lambda (int) (overlap l r (car int) (cdr int))) intervals)
-              )))
+(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))))
 
-      maximize  into max
-      minimize  into min
-      finally (return (cons min max))
-      )
 
-
-(defun coverage-edge (sensor coverage low high)
+(defun coverage-edge (sensor coverage low high test)
   (destructuring-bind (x . y) sensor
     (let ((edge (1+ coverage)))
-      (arrows:-<>
-       (loop for cx from (- x edge) to (+ x edge)
-             collecting (cons cx (- y (- edge (abs (- x cx)))))
-             collecting (cons cx (+ y (- edge (abs (- x cx))))))
-       (delete-if-not (lambda (point)
-                        (and (<= low (car point) high)
-                             (<= low (cdr point) high)))
-                      <>)
-       (delete-duplicates <> :test #'equal)))))
-
-
-(defun fail-freq-edge (markers bound)
-  (let ((sensor-coverage (sensor-coverage markers)))
-    (loop for (sensor coverage)  in sensor-coverage
-          :for candi = (loop for edge-point in (coverage-edge sensor coverage bound)
-                             :unless
-                             (loop for (other-sensor range) in sensor-coverage
-                                   :thereis (<= (manhattan-dist edge-point other-sensor) range))
-                             :return edge-point)
-          :when candi
-            :return (list sensor coverage candi))))
-
-(fail-freq-edge (markers (uiop:read-file-lines "eg-in")) 20)
-
-(coverage-edge (cons 2 18) 7 20)
-(coverage-edge (cons 9 16) 1 20)
-(coverage-edge (cons 20 1) 7 20)
-
-;; fail 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
@@ -161,48 +75,86 @@
         :when col
           :return (+ (* 4000000 col) y)))
 
-(fail-freq (markers (uiop:read-file-lines "eg-in")) 20)
-(fail-freq-edge (markers (uiop:read-file-lines "input")) 4000000)
-
-(let* ((markers )
-       (bound 20)))
-
+(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)))
 
-(let* ((lines (uiop:read-file-lines "input"))
-       (markers (markers lines))
-       (bounds (bounds markers)))
-  (list
+(defun tune-soluton (position)
+  (destructuring-bind (x y) position
+    (+ (* x 4000000) y)))
 
-   (loop for (sensor beacon) on markers by #'cddr
-         maximize (manhattan-dist sensor beacon))))
+(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)))))))
 
-(loop for (x))
-(make-array (* 4000000 4000000) :element-type '(unsigned-byte 1) :initial-element 0)
+(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)))))))
 
-(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)))
+(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)))
 
-  (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)))
+(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))))
 
-  (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 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)))))