day15.lisp (4699B)
1 (defpackage #:adventofcode2022/day15 2 (:use #:cl #:adventofcode2022)) 3 (in-package #:adventofcode2022/day15) 4 5 (defun make-min-or-max-coordinate (test) 6 (let ((x) 7 (y)) 8 (lambda (cmd &optional check-value) 9 (cond 10 ((eq cmd :set) 11 (when (or (null x) (funcall test (car check-value) x)) 12 (setf x (car check-value))) 13 (when (or (null y) (funcall test (cadr check-value) y)) 14 (setf y (cadr check-value)))) 15 ((eq cmd :get) 16 (list x y)))))) 17 18 (defun manhattan-distance (p-1 p-2) 19 (+ (abs (- (car p-1) (car p-2))) 20 (abs (- (cadr p-1) (cadr p-2))))) 21 22 (defun coord-x-y+ (coord value) 23 (list (+ (car coord) value) 24 (+ (cadr coord) value))) 25 26 (defun coord-x-y- (coord value) 27 (list (- (car coord) value) 28 (- (cadr coord) value))) 29 30 (defun get-sensor-distances (inputs) 31 (let ((distances (make-hash-table :test 'equal)) 32 (min-pos (make-min-or-max-coordinate #'<)) 33 (max-pos (make-min-or-max-coordinate #'>))) 34 (loop for input in inputs 35 for sensor = (car input) 36 for beacon = (cadr input) 37 for distance = (manhattan-distance sensor beacon) 38 do (funcall min-pos :set (coord-x-y- sensor distance)) 39 do (funcall max-pos :set (coord-x-y+ sensor distance)) 40 do (setf (gethash sensor distances) distance)) 41 (values distances (funcall min-pos :get) (funcall max-pos :get)))) 42 43 (defun get-scan-ranges (sensors y) 44 (loop for sensor being the hash-key of sensors 45 for range = (gethash sensor sensors) 46 when (and (>= y (- (cadr sensor) range)) 47 (<= y (+ (cadr sensor) range))) 48 collect (list (+ (- (car sensor) range) 49 (abs (- (cadr sensor) y))) 50 (- (+ (car sensor) range) 51 (abs (- (cadr sensor) y)))))) 52 53 (defun task1 (inputs) 54 (multiple-value-bind (distances min-pos max-pos) 55 (get-sensor-distances inputs) 56 (let* ((check-y 2000000) 57 (check-y (if (< (cadr max-pos) check-y) 58 10 ;; Test case 59 check-y)) 60 (beacons (loop with ht = (make-hash-table :test 'equal) 61 for (sensor beacon) in inputs 62 do (setf (gethash beacon ht) t) 63 finally (return ht)))) 64 (loop with scan-ranges = (get-scan-ranges distances check-y) 65 for x from (car min-pos) to (car max-pos) 66 when (and (not (gethash (list x check-y) beacons)) 67 (loop for range in scan-ranges 68 thereis (and (>= x (car range)) 69 (<= x (cadr range))))) 70 sum 1)))) 71 72 (defun task2 (inputs) 73 (multiple-value-bind (distances min-pos max-pos) 74 (get-sensor-distances inputs) 75 (declare (ignore min-pos)) 76 (let* ((search-area-min 0) 77 (search-area-max 4000000) 78 (search-area-max (if (< (cadr max-pos) search-area-max) 79 20 ;; Test case 80 search-area-max))) 81 (loop named outer 82 for y from search-area-min to search-area-max 83 for scan-ranges = (get-scan-ranges distances y) 84 do (loop for range in scan-ranges 85 for left-edge = (1- (car range)) 86 for right-edge = (1+ (cadr range)) 87 do (loop for x in (list left-edge right-edge) 88 when (and (>= x search-area-min) 89 (<= x search-area-max)) 90 unless (loop for range in scan-ranges 91 thereis (and (>= x (car range)) 92 (<= x (cadr range)))) 93 do (return-from outer (+ (* x 4000000) y)))))))) 94 95 (define-day 15 96 (:translate-input (lambda (line) 97 (let* ((parts (str:split " " line)) 98 (sx (nth 2 parts)) 99 (sx (subseq sx 2 (1- (length sx)))) 100 (sy (nth 3 parts)) 101 (sy (subseq sy 2 (1- (length sy)))) 102 (bx (nth 8 parts)) 103 (bx (subseq bx 2 (1- (length bx)))) 104 (by (subseq (nth 9 parts) 2))) 105 (list (list (parse-integer sx) 106 (parse-integer sy)) 107 (list (parse-integer bx) 108 (parse-integer by)))))) 109 #'task1 110 #'task2)