Paste: AoC 2022 Day 15

! Copyright (C) 2022 Keldan Chapman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel AOC prettyprint math.parser regexp sequences grouping math combinators
       math.vectors interval-sets sets accessors sequences.extras combinators.extras
       arrays sorting ranges math.combinatorics combinators.short-circuit math.order ;
IN: AOC.2022.15

M: interval-set cardinality array>> 2 group [ first2 swap - ] map-sum ;

: dist ( seq -- n ) first4 swapd [ - abs ] 2bi@ + ;

: >interval ( seq n -- interval ) [ [ dist ] [ first2 ] bi ] dip
    - abs swapd - [ - ] [ + ] 2bi 2array ;

: included? ( a b -- ? ) [ <interval-and> ] keep = ;

: ranges ( seq n -- r ) '[ _ >interval ] map natural-sort unclip 1array <interval-set>
    [ 1array <interval-set> 2dup included? [ drop ] [ <interval-or> ] if ] reduce ;

: beacons ( seq n -- m ) [ [ 2 tail ] map ] dip '[ last _ = ] filter members length ;

: parse-input ( input -- seq ) R/ -?\d+/ [ subseq dec> ] map-matches ;

: part-1 ( input -- result )  parse-input dup <evens> infimum [ v-n 4 group ] keep
    2000000 swap - [ ranges cardinality ] [ beacons ] 2bi - ;

! Part 2 uses nothing from part one except the distance function. Its pretty fast though!

: options ( s1 s2 -- seq )
    [ [ first2 ] [ dist 1 + ] bi ] bi@
    [ [ + ] dip [ + ] [ - ] 2bi ] [ [ swap - ] dip [ + ] [ - ] 2bi ] 3bi*
    [ { [ drop nip + 2 / ] [ 2nip + 2 / ] [ drop + 2 / nip ] [ nip + 2 / nip ] } 4cleave 4array ]
    2keep [ '[ _ - ] ] bi@ 2dup 4array [ over [ call( x -- x ) ] dip 2array ] 2map ;

: valid ( seq pair -- seq ? ) {
        [ first integer? ]
        [ [ 0 4000000 between? ] all? ]
        [ dupd '[ [ dist ] [ first2 _ first2 4array dist ] bi < ] all? ]
    } 1&& ;

: part-2 ( input -- result )
    parse-input 4 group dup 2 <k-permutations>
    [ first2 options ] map concat [ valid ] filter nip
    first first2 swap 4000000 * + ;

MAIN: [ 15 read-day-input [ part-1 . ] [ part-2 . ] bi ]