diff options
author | Oscar Najera <hi@oscarnajera.com> | 2022-12-17 22:02:47 +0100 |
---|---|---|
committer | Oscar Najera <hi@oscarnajera.com> | 2022-12-17 22:02:47 +0100 |
commit | 58e182c92d2d34f62040f88e49ece01881000e08 (patch) | |
tree | 4398c97a48a734b7c8514b21d3468f723f77074d /AoC2022 | |
parent | 9a74572be82cadabd7c09ce16d966db0d36dc9c9 (diff) | |
download | scratch-58e182c92d2d34f62040f88e49ece01881000e08.tar.gz scratch-58e182c92d2d34f62040f88e49ece01881000e08.tar.bz2 scratch-58e182c92d2d34f62040f88e49ece01881000e08.zip |
day 15 redo part 1 for speed
Diffstat (limited to 'AoC2022')
-rw-r--r-- | AoC2022/15/solver.lisp | 64 |
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) |