From 9a74572be82cadabd7c09ce16d966db0d36dc9c9 Mon Sep 17 00:00:00 2001 From: Oscar Najera Date: Sat, 17 Dec 2022 21:21:23 +0100 Subject: [AoC2022] Common LISP day 15 fast enough solution --- AoC2022/15/input | 24 +++++ AoC2022/15/solver.lisp | 238 ++++++++++++++++++++----------------------------- 2 files changed, 119 insertions(+), 143 deletions(-) create mode 100644 AoC2022/15/input (limited to 'AoC2022/15') 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))))) -- cgit v1.2.3