Paste: AOC dec 3 2023

IN: dec-3
USING: io io.encodings.utf8 io.files io.pathnames kernel math.parser namespaces
sequences unicode regexp assocs math ranges sequences.product arrays
sequences.deep accessors ;

: read-input ( -- seq )
home "Desktop/aoc2023/dec-3/input.txt" append-path
utf8 file-lines ;

: position>edges ( integer -- seq )
dup [ 1 - ] [ 1 + ] bi 3array ;

: xy>halo ( integer integer -- seq )
[ position>edges ] bi@ 2array <product-sequence> >array ;

: unique ( seq -- seq )
[ dup ] H{ } map>assoc values ;

! TODO: flatmap doesn't exist but map-reduce does
: slice>halo ( y xslice -- seq )
[ from>> ] [ to>> ] bi [a..b) ! convert slice to range
[ over xy>halo ] map flatten1 unique ! find all xy points on halo
nip ! consume y
;

: in-upper-bounds? ( element bounds -- ? )
[ <= ] 2map first2 and ;

: in-lower-bounds? ( element bounds -- ? )
[ >= ] 2map first2 and ;

: in-bounds? ( element lower upper -- ? )
[ dupd in-lower-bounds? swap ] dip in-upper-bounds? and ;

: bounded-halo ( halo lower upper -- halo )
rot [ 2over in-bounds? ] filter 2nip ;

: get-upper-bounds ( lines -- bounds )
[ first length 1 - ] [ length 1 - ] bi 2array ;

: machine-at? ( xy lines -- ? )
[ first2 ] dip nth nth 1array "" like
R/ [^0-9.]/ matches? ;

: beside-machine? ( y slice lines -- ? )
[ slice>halo { 0 0 } ] dip ! halo lowerbound lines
[ get-upper-bounds ] keep ! halo lowerbound upperbound lines
[ bounded-halo ] dip ! bounded-halo lines
swap [ over machine-at? ] map nip [ ] any? ;

: beside-machines ( y slice lines -- seq )
[ slice>halo { 0 0 } ] dip ! halo lowerbound lines
[ get-upper-bounds ] keep ! halo lowerbound upperbound lines
[ bounded-halo ] dip ! bounded-halo lines
swap [ [ over machine-at? ] keep f ? ] map nip sift ;

: part-number ( y slice lines -- integer )
[ drop nip string>number ] 3keep
beside-machine? swap f ? ;

TUPLE: machine-part xy partnumber type ;
: <machine-part> ( xy number type -- part )
machine-part boa ;

: part ( y slice lines -- part/f )
[ drop nip string>number ] 3keep ! part-number y slice lines 
[ beside-machines ?first ] keep ! part-number machinexy/f lines
over
[ [ dup first2 ] dip nth nth 1array "" like ! part-number machinexy type
  [ swap ] dip <machine-part> ]
[ 3drop f ] if ;

: line>partnumbers ( str -- seq )
R/ \d+/ all-matching-slices ;

: line-part-numbers ( y lines -- seq )
[ nth line>partnumbers ] 2keep rot ! y lines slices
[ [ over ] dip pick part ] map
2nip sift ;

: get-all-parts ( lines -- seq )
dup length [0..b)
[ over line-part-numbers ] map concat nip ;

: gear-ratios ( machineparts -- seq )
[ type>> "*" = ] filter ! make sure they're all cogs
H{ } clone swap
[ [ partnumber>> ] [ xy>> ] bi pick push-at ] each
values
[ length 2 = ] filter
[ product ] map ;

: solve1 ( -- integer )
read-input
get-all-parts
[ partnumber>> ] map
sum ;

: solve2 ( -- integer )
read-input
get-all-parts
gear-ratios
sum ;