! 2022 nomennescio
! USING: combinators.extras kernel sequences.extras ;
USING: accessors combinators.extras io.encodings.utf8 io.files kernel make math math.intervals math.order math.parser math.vectors multiline prettyprint sequences sequences.extras sorting splitting ;

IN: aoc2022

TUPLE: sensor center beacon radius top-bottom ;

: x±r ( x r -- [x-r,x+r] ) [ - ] [ + ] 2bi [a,b] ;
: parse-file ( path encoding -- sensors ) file-lines [ "=,:" split [ dec> ] map-sift (( { cx cy bx by } )) 2 cut 2dup v- vabs sum pick second over x±r sensor boa ] map ;

:: section ( y sensor -- interval/f ) y sensor top-bottom>> interval-contains? [ sensor center>> first2 swap [ y - abs neg sensor radius>> + ] [ swap x±r ] bi* ] [ f ] if ;
: left-section ( x y sensor -- interval/f ) section [ swap [0,b] interval-intersect ] [ drop f ] if* ;
: sort-intervals ( intervals -- intervals' ) [ 2dup intervals-intersect? [ 2drop +eq+ ] [ [ from>> ] bi@ endpoint< [ +lt+ ] [ +gt+ ] if ] if ] sort ;
: (merge-intervals) ( intervals -- intervals' ) [ unclip [ 2dup intervals-intersect? [ interval-union ] [ [ , ] dip ] if ] reduce , ] { } make ;
: merge-intervals ( intervals -- intervals' ) sort-intervals [ [ (merge-intervals) ] keep over [ length ] bi@ = not ] loop ;
: covered ( y sensors -- intervals ) [ dupd section ] map-sift nip merge-intervals ;
: left-covered ( x y sensors -- intervals ) [ [ 2dup ] dip left-section ] map-sift 2nip merge-intervals ;
: gap ( intervals -- x/f ) dup length 2 = [ first to>> first 1 + ] [ drop f ] if ;
: find-beacon ( sensors radius -- y x ) dup <iota> [ dupd reach left-covered gap ] [ ] find-pred drop swap 2nipd ;

: part1 ( y sensors -- n ) covered [ interval-length ] map-sum ;
: part2 ( sensors radius -- n ) find-beacon 4000000 * + ; 

CONSTANT: file "input-15.txt"
CONSTANT: row 2000000
CONSTANT: radius 4000000 

: day15 ( -- ) file utf8 parse-file [ [ row ] dip part1 . ] [ radius part2 . ] bi ;

MAIN: day15