482 lines
18 KiB
Common Lisp
482 lines
18 KiB
Common Lisp
;; https://adventofcode.com/2022/day/15
|
|
;;
|
|
;; oh, wow. i can already imagine the second part of the task
|
|
;; so. for arrangements of (sensor closest-beacon)
|
|
;; i need to figure out which points are out of rangle for all sensors?
|
|
;; where "range" is distance between sensor and the closest-beacon
|
|
;;
|
|
;; so for each sensor also store distance, and each sensor should be able to answer query for point
|
|
;; whether it disproves existence of a beacone there
|
|
;; then for ( POINTS x SENSORS ) computations i'll be able to mark all points that aren't covered.
|
|
;;
|
|
;; doesn't seem like too much
|
|
|
|
(ql:quickload 'cl-ppcre)
|
|
;; poor man's parsing
|
|
(rest (mapcar (lambda (str)
|
|
(parse-integer str :junk-allowed t))
|
|
(cl-ppcre:split "="
|
|
"Sensor at x=2, y=18: closest beacon is at x=-2, y=15")))
|
|
|
|
;; manhattan distance : https://en.wikipedia.org/wiki/Taxicab_geometry
|
|
;; sum of abs of coord-diffs
|
|
|
|
(defclass point ()
|
|
((x :initarg :x :reader x)
|
|
(y :initarg :y :reader y)))
|
|
|
|
(defmethod print-object ((obj point) stream)
|
|
(print-unreadable-object (obj stream :type t)
|
|
(with-slots (x y)
|
|
obj
|
|
(format stream "x:~a y:~a" x y))))
|
|
|
|
(defparameter *test-point-1*
|
|
(make-instance 'point :x 1 :y 19))
|
|
|
|
(defparameter *test-point-2*
|
|
(make-instance 'point :x -2 :y -20))
|
|
|
|
(defmethod manh-dist ((one point) (two point))
|
|
(+ (abs (- (x one) (x two)))
|
|
(abs (- (y one) (y two)))))
|
|
|
|
(manh-dist *test-point-1* *test-point-2*)
|
|
;; i guess this is right
|
|
|
|
(defclass sensor ()
|
|
((self-coord :initarg :self :reader self-coord)
|
|
(beacon-coord :initarg :beacon :reader beacon-coord)
|
|
(covered-dist :initarg :dist :reader covered-dist)))
|
|
|
|
(defun make-sensor (sens-x sens-y beac-x beac-y)
|
|
(let* ((sensor (make-instance 'point :x sens-x :y sens-y))
|
|
(beacon (make-instance 'point :x beac-x :y beac-y))
|
|
(dist (manh-dist sensor beacon)))
|
|
(make-instance 'sensor :self sensor :beacon beacon :dist dist)))
|
|
|
|
(defmethod print-object ((obj sensor) stream)
|
|
(print-unreadable-object (obj stream :type t)
|
|
(with-slots (self-coord beacon-coord covered-dist)
|
|
obj
|
|
(format stream "at: ~a, linked to: ~a, covering dist: ~a"
|
|
self-coord beacon-coord covered-dist))))
|
|
|
|
|
|
(defparameter *test-sensor* (make-sensor 2 18 -2 15))
|
|
|
|
(defmethod can-have-unknown-beacon-p ((p point) (s sensor))
|
|
(> (manh-dist p (self-coord s))
|
|
(covered-dist s)))
|
|
|
|
(manh-dist *test-point-1* (self-coord *test-sensor*))
|
|
(can-have-unknown-beacon-p *test-point-1* *test-sensor*)
|
|
|
|
(manh-dist *test-point-2* (self-coord *test-sensor*))
|
|
(can-have-unknown-beacon-p *test-point-2* *test-sensor*)
|
|
|
|
;; ok. now read in all sensors?
|
|
;; and then for line with specified 'y'
|
|
;; and from leftmost to rightmost S or B for each point ask each sensor if possible
|
|
;; to have an unknown beacon, if any says "no" - then no
|
|
;; otherwise - count
|
|
|
|
(defparameter *day15-input-file* "day15-test.txt")
|
|
|
|
|
|
(defun line-to-coords (line)
|
|
(rest (mapcar (lambda (str)
|
|
(parse-integer str :junk-allowed t))
|
|
(cl-ppcre:split "=" line))))
|
|
|
|
(defparameter *day15-sensors-list* nil)
|
|
(setq *day15-sensors-list*
|
|
(mapcar (lambda (coords-list)
|
|
(apply #'make-sensor coords-list))
|
|
(mapcar #'line-to-coords (uiop:read-file-lines *day15-input-file*))))
|
|
|
|
;; next - find lovest x and highest x
|
|
;; but then i guess i'd also want lovest and highest y overall
|
|
|
|
;; that's neat
|
|
(loop
|
|
for sensor in *day15-sensors-list*
|
|
minimize (x (self-coord sensor)) into xs
|
|
minimize (x (beacon-coord sensor)) into xs
|
|
maximize (x (self-coord sensor)) into xm
|
|
maximize (x (beacon-coord sensor)) into xm
|
|
minimize (y (self-coord sensor)) into ys
|
|
minimize (y (beacon-coord sensor)) into ys
|
|
maximize (y (self-coord sensor)) into ym
|
|
maximize (y (beacon-coord sensor)) into ym
|
|
finally (return (list xs xm ys ym)))
|
|
;; (-2 25 0 22)
|
|
|
|
;; now for line y=10 check all x and count how many -for-all- sensors allow new point
|
|
|
|
(defun all-sensors-allow-for-hidden-beacon (point sensors)
|
|
(macroexpand `(and ,@(mapcar (lambda (sensor) (can-have-unknown-beacon-p point sensor))
|
|
sensors))))
|
|
|
|
(defun all-sensors-allow-for-hidden-beacon (point sensors)
|
|
(not (position nil (mapcar (lambda (sensor) (can-have-unknown-beacon-p point sensor))
|
|
sensors))))
|
|
|
|
;; well, do i have to write my own function for AND ?
|
|
(when (all-sensors-allow-for-hidden-beacon *test-point-2* *day15-sensors-list*)
|
|
1)
|
|
|
|
(when (all-sensors-allow-for-hidden-beacon *test-point-1* *day15-sensors-list*)
|
|
1)
|
|
|
|
;; count how many ARE covered
|
|
(loop
|
|
for x from -2 to 25
|
|
count (not (all-sensors-allow-for-hidden-beacon
|
|
(make-instance 'point :x x :y 10)
|
|
*day15-sensors-list*)))
|
|
|
|
;; on the image it's from -2 and till 24, so should be 27, if counting 0
|
|
;; well. we're counting posistions "wher beacon can't possibly exist"
|
|
;; so removing points which _are_ beacons?
|
|
;;
|
|
;; and - range needs to be extended significantly, no?
|
|
;; what would be enough?
|
|
;; doubling into each direction?
|
|
|
|
(defmethod points-equal ((left point) (right point))
|
|
(and (= (x left) (x right))
|
|
(= (y left) (y right))))
|
|
|
|
|
|
(points-equal (make-instance 'point :x 1 :y 1)
|
|
(make-instance 'point :x 1 :y 1))
|
|
|
|
(defun possible-to-have-beacon (point sensors)
|
|
(let ((all-checks
|
|
(mapcar (lambda (sensor)
|
|
(if (points-equal point (beacon-coord sensor))
|
|
'known-sensor
|
|
(can-have-unknown-beacon-p point sensor) ; single NIL means - not possible to have unknown
|
|
))
|
|
sensors)))
|
|
(or (not (position nil all-checks)) ; nil if all sensors allow (said T) presense of unknown beacons
|
|
(position 'known-sensor all-checks) ; exists known sensor
|
|
)))
|
|
;; beacon is possible : either sensor has beacon at that point
|
|
;; or position is out of the sensor range
|
|
;; but here's the thing. if sencor-beacon is at this point - need to short-circuit T
|
|
|
|
(possible-to-have-beacon *test-point-2* *day15-sensors-list*)
|
|
|
|
(possible-to-have-beacon *test-point-1* *day15-sensors-list*)
|
|
|
|
(possible-to-have-beacon (make-instance 'point :x -2 :y 15) *day15-sensors-list*)
|
|
|
|
;; i guess that works
|
|
|
|
;; count how many ARE covered
|
|
(loop
|
|
for x from -2 to 25
|
|
count (not (possible-to-have-beacon
|
|
(make-instance 'point :x x :y 10)
|
|
*day15-sensors-list*)))
|
|
|
|
;; ok.
|
|
|
|
;;
|
|
;; new idea:
|
|
;; have class for "not intersecting intervals"
|
|
;; with method to add ( ? remove ) new interval
|
|
|
|
;; in part 2 we're looking for points which are outside of all scanners
|
|
;; where "last beacon" can be
|
|
|
|
;; start of idea - distance goes by x and y simmetrically.
|
|
;; between line Y1 and beacon (X2 Y2) we can calculate Y2 - Y1,
|
|
;; if that is > than length covered - then knowingly 0 points covered by scanners
|
|
;; if htat is < that covered length : abs(Y2 - Y1) = diff
|
|
;; that diff will be covered into both sides to the left and to the right of the X2
|
|
;; (Y1 X2) will be exactly diff distance away.
|
|
;; so (length - diff) is by how much we can go to the left and right and still be with distance to beacon upto length
|
|
;; Interval [(x2-diff, y1) .. (x2+diff, y1)] are all points where "there can't be unkown beacons"
|
|
;;
|
|
;; and my idea is to operate on the point intervals.
|
|
;; start with "total interval" from 0 to 4M, i guess
|
|
;; then - for each beacon calculate Interval where "can't be unknown beacons"
|
|
;; and subtract them from the line
|
|
;;
|
|
;; without use of "per point" is best
|
|
;; so. want to have class, that stores non-intersecting intervals ( scala SortedMap would be good here )
|
|
;;
|
|
;; but ok, can be just ((start end) (start2 end2)) sorted by #'first after every operation
|
|
;; what would be algo for "removing interval"
|
|
;;
|
|
;; go though the increasing 'interval starts', find first that's > our-start
|
|
;; then check current interval and previous interval
|
|
;;
|
|
;; previous interval could have end that clips current-interval
|
|
;; at-which-we-stopped could clip "end" of current-interval
|
|
|
|
;; should i just have class for interval? nah, just method, since no need in type checking?
|
|
|
|
(defun subtract-interval (minuend subtrahend)
|
|
(destructuring-bind ((m-left m-right) (s-left s-right)) (list minuend subtrahend)
|
|
(let ((resulting-interval
|
|
(if (< m-left s-left)
|
|
(list ; minuend starts to the left
|
|
m-left (min m-right s-left))
|
|
(list ; minuend starts to the right
|
|
s-right m-right)
|
|
)))
|
|
(when (<= (first resulting-interval) (second resulting-interval)) ; >= to allow intervals [4 4]
|
|
resulting-interval))))
|
|
|
|
(subtract-interval '(1 100) '(0 101)) ; NIL correct
|
|
(subtract-interval '(1 100) '(10 20)) ; only one return value, incorrect
|
|
|
|
;; oh, but it can be that our subrahend fully devours "to the right" and we'd need to check "next to the right"
|
|
;; ugh
|
|
;; went to search and found 'cl-interval
|
|
|
|
(ql:quickload 'cl-interval)
|
|
(interval:make-interval :start 1 :end 100 )
|
|
;; this is not what i need?
|
|
(defparameter *some-tree*
|
|
(interval:make-tree ))
|
|
(interval:insert *some-tree* (interval:make-interval :start 1 :end 100) )
|
|
(interval:delete *some-tree* (interval:make-interval :start 10 :end 20) )
|
|
*some-tree*
|
|
(interval:find-all *some-tree* 11) ; nope deletion doesn't work like i want it
|
|
|
|
;; ugh. write it on my own
|
|
(defstruct ([] (:constructor [] (low high)))
|
|
(low 0.0 :type real)
|
|
(high 0.0 :type real))
|
|
|
|
(defmethod sub ((i1 []) (i2 []))
|
|
([] (- ([]-low i1) ([]-high i2))
|
|
(- ([]-high i1) ([]-low i2))))
|
|
|
|
(sub ([] 1 100) ([] 10 20)) ; ([] -19 90) that's bs
|
|
|
|
;;; ugh. this is somethign completely different
|
|
;; so, back to my function
|
|
;; should be able to return list of intervals. either one or two if split
|
|
(defun subtract-interval (minuend subtrahend)
|
|
(destructuring-bind ((m-left m-right) (s-left s-right)) (list minuend subtrahend)
|
|
(cond
|
|
((< m-right s-left) (list m-left m-right)) ; minuend fully to the left
|
|
((> m-left s-right) (list m-left m-right)) ; minuend fully to the right
|
|
((and (< m-left s-left)
|
|
(> m-right s-right)) ; minuend is around subtrahend
|
|
(list (list m-left (1- s-left))
|
|
(list (1+ s-right) m-right))) ; part before and after subtrahend
|
|
((and (>= m-left s-left)
|
|
(<= m-right s-right)) ; subtrahend consumes minuend
|
|
nil)
|
|
((< m-left s-left) ; minuend start to the left, but not subtrahend consumes all right part
|
|
(list m-left (1- s-left)))
|
|
((> m-right s-right) ; minuend has part to the right of subtrahend
|
|
(list (1+ s-right) m-right)))))
|
|
|
|
(subtract-interval '(1 100) '(0 101)) ; NIL correct
|
|
(subtract-interval '(1 100) '(10 20)) ; two intervals, correct
|
|
(subtract-interval '(1 20) '(10 30)) ; correct, had deducted 10
|
|
(subtract-interval '(10 30) '(1 20)) ; correct, had deducted 20
|
|
(subtract-interval '(25 30) '(1 20)) ; correct, not changed
|
|
(subtract-interval '(1 20) '(25 30)) ; correct not changed
|
|
(subtract-interval '(1 20) nil) ; correct not changed
|
|
|
|
;; ok. now what. have interval
|
|
'(0 4000000) ; and deduct from it found intervals.
|
|
; it would produce list of intervals
|
|
; so for each new interval - deduct from all
|
|
; then i'll have list of intervals, where "unknown beacon is possible"
|
|
|
|
|
|
;; now. hm.
|
|
;; loop. no. first function that for LINE-Y and BEACON-CENTER calculates "no-unkown-beacons" interval
|
|
|
|
(defun get-no-unknown-beacons-x-interval (line-y scanner)
|
|
(let* ((y-dist (abs (- line-y (y (self-coord scanner)))))
|
|
(x-slack (- (covered-dist scanner) y-dist))
|
|
(x-sc (x (self-coord scanner))))
|
|
(when (>= x-slack 0)
|
|
(list (- x-sc x-slack) (+ x-sc x-slack)))))
|
|
|
|
*test-sensor* ; x: 2, y: 18, dist: 7
|
|
(y (self-coord *test-sensor*))
|
|
|
|
(get-no-unknown-beacons-x-interval 18 *test-sensor*)
|
|
(get-no-unknown-beacons-x-interval 17 *test-sensor*)
|
|
(get-no-unknown-beacons-x-interval 19 *test-sensor*)
|
|
;; should be (-5 9)
|
|
|
|
(get-no-unknown-beacons-x-interval 11 *test-sensor*)
|
|
(manh-dist (make-instance 'point :x 2 :y 11) (self-coord *test-sensor*))
|
|
;; seems right
|
|
|
|
(get-no-unknown-beacons-x-interval 4 (make-sensor 1 1 2 2))
|
|
;; seems right
|
|
|
|
(get-no-unknown-beacons-x-interval 2 *test-sensor*)
|
|
;; yup
|
|
|
|
;; now. start with interval '(0 4000000)
|
|
;; list of that interval
|
|
;; when working on a line
|
|
;; get 'no-unknowns' interval for each scanner
|
|
;; then for each interval in the lists -
|
|
;; take it oud and put results of subtraction instead
|
|
|
|
(defun subtract-from-all (intervals subtrahend)
|
|
(mapcan (lambda (interval) (subtract-interval interval subtrahend))
|
|
intervals))
|
|
|
|
(subtract-from-all '((1 4000000)) '(5 15)) ; yay
|
|
(subtract-from-all '((1 10) (12 17) (20 25)) '(5 23)) ; yay
|
|
(subtract-from-all '((3 10) (12 17) (20 25)) '(1 40)) ; yay
|
|
(subtract-from-all '((3 10) (12 17) (20 25)) nil) ; yay
|
|
|
|
;; now looping.
|
|
;; we fix line, then for each scanner we calculate interval and update our intervals
|
|
;; in the end - if not NIL - then some points can have "unknown beacond"
|
|
|
|
;; let's figure out inner loop first
|
|
(defun line-unknown-intervals (y scanners max-x)
|
|
(do*
|
|
((rest-scanners scanners (cdr rest-scanners))
|
|
(scanner (first rest-scanners) (first rest-scanners))
|
|
(known-interval (get-no-unknown-beacons-x-interval y scanner)
|
|
(when scanner (get-no-unknown-beacons-x-interval y scanner)))
|
|
(intervals (subtract-from-all `((0 ,max-x)) known-interval)
|
|
(subtract-from-all intervals known-interval)))
|
|
((not scanner) intervals)
|
|
;; (format t "step, ~a intervals, after removing ~a; from ~a ~%" intervals known-interval scanner)
|
|
))
|
|
|
|
(line-unknown-intervals 11 (get-sensors-list "day15-test.txt") 20)
|
|
(line-unknown-intervals 10 (get-sensors-list "day15-test.txt") 20)
|
|
;; 2: (SUBTRACT-FROM-ALL ((0 2) 14 4000000) (-3 3))
|
|
;; why is that intervals get polluted
|
|
;;
|
|
;; anothre problem we don't include last scanner?
|
|
;;
|
|
;; and another problem. do we remove too little?
|
|
;; step, ((-40 11) (13 40)) intervals, after removing (12 12); from #<SENSOR at: #<POINT x:12 y:14>, linked to: #<POINT x:10 y:16>, covering dist: 4>
|
|
;; for line y=10, dist 4, sensor at <POINT x:12 y:14>, no all ok
|
|
|
|
;; so, proposed answer is x=14, y=11
|
|
;; which sensor precludes that in my process?
|
|
;; step, ((-40 10) (14 40)) intervals, after removing (11 13); from #<SENSOR at: #<POINT x:12 y:14>, linked to: #<POINT x:10 y:16>, covering dist: 4>
|
|
;; <SENSOR at: #<POINT x:12 y:14>, linked to: #<POINT x:10 y:16>, covering dist: 4>
|
|
;; for y=11. dist is 3. so 12+-1 right?
|
|
(manh-dist (make-instance 'point :x 12 :y 14)
|
|
(make-instance 'point :x 14 :y 11))
|
|
;; so here distance is 5. wtf.
|
|
;; so. y=11
|
|
;; sensor at <POINT x:12 y:14>
|
|
;; we spend 3 12+-1 wtf
|
|
;; OOOH. it's (14 14) - meaning X is 14
|
|
;; and Y is 11
|
|
;; crap
|
|
|
|
|
|
(subtract-from-all '((1 4000000)) '(3 13)) ; yay
|
|
;; using (format t "step, ~a intervals, after removing ~a ~%" intervals known-interval)
|
|
;; inside of DO loop
|
|
(subtract-from-all '((0 10) (14 400000)) '(3 13)) ; whoa
|
|
(subtract-interval '(14 400000) '(3 13)) ; correct not changed
|
|
;; well that's because in the "all below" i return not list of list
|
|
;; hello type safety, man
|
|
|
|
|
|
(defparameter *day-15-2-ans* nil)
|
|
(setq *day-15-2-ans*
|
|
(let ((sensors (get-sensors-list "day15-input.txt")))
|
|
(loop
|
|
for y from 1 to 4000000
|
|
for y-unknown-intervals = (line-unknown-intervals y sensors 4000000)
|
|
when y-unknown-intervals collect (list y y-unknown-intervals)
|
|
when (= 0 (mod y 10000)) do (format t "in step ~a~%" y))))
|
|
(print *day-15-2-ans*)
|
|
;; well, there are lots of "possible solutions", ugh
|
|
|
|
(defparameter *day-15-2-test* nil)
|
|
(setq *day-15-2-test*
|
|
(let ((sensors (get-sensors-list "day15-test.txt")))
|
|
(loop
|
|
for y from 0 to 20
|
|
for y-unknown-intervals = (line-unknown-intervals y sensors 20)
|
|
when y-unknown-intervals collect (list y y-unknown-intervals)
|
|
when (= 0 (mod y 1000)) do (format t "in step ~a~%" y))))
|
|
*day-15-2-test*
|
|
|
|
;; so, i do find the answer, but also lots of NON ANSWERS:
|
|
'((11 ((14 14))) (12 ((3 3))) (13 ((2 4))) (14 ((1 5))) (15 ((0 6)))
|
|
(16 ((0 7))) (17 ((0 8))) (18 ((0 7))) (19 ((0 6))) (20 ((0 5))))
|
|
|
|
;; for example :x 3 :y 12
|
|
;; it should have been thrown out. why not? which scanner should have covered it
|
|
(line-unknown-intervals 12 (get-sensors-list "day15-test.txt") 20)
|
|
;; for example (3 12) and (-2 15 #7) nope, ok
|
|
;; for example (3 12) and (8 7 #9) nope, ok
|
|
|
|
;; i need to automate it. for all scanners, find what? closest?
|
|
(let ((p (make-instance 'point :x 3 :y 12)))
|
|
(loop
|
|
for scanner in (get-sensors-list "day15-test.txt")
|
|
collect (list (manh-dist (self-coord scanner) p) (covered-dist scanner))))
|
|
;; so for 1st scanner, dist 7 and covered-dist is 7.
|
|
;; UGH
|
|
;; and
|
|
;; - step, ((0 20)) intervals, after removing (1 3); from #<SENSOR at: #<POINT x:2 y:18>, linked to: #<POINT x:-2 y:15>, covering dist: 7>
|
|
;; here it was all along
|
|
|
|
(subtract-from-all '((0 20)) '(1 3 ))
|
|
;; maybe that's bug of first iteration of DO* or something
|
|
;; it would be in "non-covered interval"
|
|
|
|
|
|
;; maybe i don't remove enough?
|
|
;; i should remove interval where all points "covered by the sensor"
|
|
|
|
;; do i want to draw that shit?
|
|
'(((-40 -8) (28 40)) ((-40 -7) (27 40)) ((-40 -6) (26 40)) ((-40 -5) (25 40))
|
|
((-40 -4) (24 40)) ((-40 -3) (23 40)) ((-40 -2) (22 40)) ((-40 -1) (23 40))
|
|
((-40 -2) (24 40)) ((-40 -3) (25 40)) ((-40 -4) (14 14) (26 40))
|
|
((-40 -3) (3 3) (27 40)) ((-40 -2) (2 4) (28 40)) ((-40 -1) (1 5) (29 40))
|
|
((-40 6) (28 40)) ((-40 7) (27 40)) ((-40 8) (26 40)) ((-40 7) (25 40))
|
|
((-40 6) (24 40)) ((-40 5) (24 40)))
|
|
|
|
(defun draw-line-def (line-intervals)
|
|
(format t "!")
|
|
(do*
|
|
((intervals line-intervals (cdr intervals))
|
|
(prev-interval nil interval)
|
|
(interval (first intervals) (first intervals)))
|
|
((not interval) nil)
|
|
;; (format t "iteration int: ~a; prev: ~a" interval prev-interval)
|
|
(when (not prev-interval)
|
|
(dotimes (i (first interval))
|
|
(format t ".")))
|
|
(when prev-interval
|
|
(dotimes (i (- (first interval) (second prev-interval)))
|
|
(format t ".")))
|
|
(dotimes (i (- (second interval) (first interval)))
|
|
(format t "#"))
|
|
)
|
|
(format t "!") (terpri)
|
|
)
|
|
|
|
(draw-line-def '((-40 -8) (28 40)))
|
|
;; ok, i have 'draw-line'
|
|
(loop for line-def in *day-15-2-test* do
|
|
(draw-line-def line-def))
|
|
;;
|
|
;; let's yolo
|
|
(2175292 ((2335771 2335771)))
|
|
(+ (* 2335771) 2175292)
|
|
;; that didn't work
|