Paste: My attempt at AOC day 8

! day 8

! from day 4 solution:
! : at-coord ( x y grid -- val ) swapd nth nth ;
! : valid-grid-index ( x y grid -- x y grid ? ) [ tuck [ length [ < ] [ drop 0 >= ] 2bi and ] [ first length [ < ] [ drop 0 >= ] 2bi and ] 2bi* and ] 3check ;

: by-cols ( grid -- cols ) [ first length ] keep [ [ nth ] with map ] curry map-integers ;

: antinode-coords ( x1 y1 x2 y2 -- x y ) 4dup [ 2nipd ] 4dip swapd [ - ] 2bi@ swapd [ - ] 2bi@ ;

: but-index ( n seq -- seq ) [ nipd = not ] with filter-index  ;

: all-pairs ( seq -- pairs ) dup [ but-index [ 2array ] with map ] curry map-index concat  ;

: 3bi* ( x1 y1 z1 x2 y2 z2 p q -- ) [ 3dip ] dip call ; inline

: 3bi@ ( x1 y1 z1 x2 y2 z2 q -- ) dup 3bi* ; inline

: each-pair ( ... seq quot: ( ... elt1 elt2 -- ... ) -- ... )
    [ first2 ] prepose [ all-pairs ] dip each ; inline

: signals ( grid -- signal-coords )
    [ V{ } clone dup ] dip dup length
    [
        over first length [
            [ rot at-coord ] 2keep rot [
                roll [ [ first = ] with find drop ] 2check
                [
                    nipd -roll [ [ 2array ] dip swap suffix! ] 2with change-nth
                ] [
                    -roll [ 2array ] dip swap 2array >vector suffix! drop
                ] if*
            ] [ 3drop ] if*
        ] 2with with each-integer
    ] 2with each-integer  ;

: print-signals ( width height signal-coords -- ) spin [ [ swap 2array [ swap index ] curry find nip [ first 1string write ] [ "." write ] if* ] 2with each-integer "\n" write ] curry with each-integer ;

: print-antinodes ( width height antinode-coords -- ) spin [ [ swap 2array swap index [ "#" write ] [ "." write ] if  ] 2with each-integer "\n" write ] curry with each-integer ;

: print-grid ( grid antinode-coords -- ) [ [ roll [ 3nip 1string write ] [ -rot 2array swap index [ "#" write ] [ "." write ] if ] if* ] 2curry each-index "\n" write ] curry each-index  ;

: all-antinode-coords-for-signal ( signal -- coords ) [ 1 tail [ [ [ first2 ] bi@ antinode-coords 2array , ] dup 2bi ] each-pair ] { } make ;

: combine-no-dup ( seq1 seq2 -- seq ) swap [ 2dup swap index [ drop ] [ suffix ] if ] reduce ;

: suffix-no-dup ( seq elt -- seq ) 2dup swap index [ drop ] [ suffix ] if ;

: all-antinode-coords ( grid signals -- coords )
    [ all-antinode-coords-for-signal [ first2 rot valid-grid-index 3nip ] with filter ] with map V{ } clone [ combine-no-dup ] reduce ;

: solve-day-eight ( grid -- antinode-count ) dup signals all-antinode-coords length ;

: parse-day-eight-input ( string -- grid ) split-lines harvest by-cols [ [ dup CHAR: . = [ drop f ] when ] map ] map ;

! (below: the main problem with stack-based languages (or maybe it's just me))
: antinode-line ( width height x1 y1 x2 y2 -- coords )
    [ [ [ 2dup 2dup t ] 4dip [ [ 0 >= and ] 4 napply ] 4keep [ roll ] dip swap [ swapd [ > ] 2bi@ and ] 3dip rotd and [ swapd [ > ] 2bi@ and ] dip and ] 4keep [ roll ] dip swap ]
    [ [ [ antinode-coords ] 2keep -rotd -rot ] 2keep 2array ] collector [ while 4drop 2drop ] dip  ;

: all-p2-antinode-coords-for-signal ( width height signal -- coords ) 1 tail [ [ rotd [ first2 ] bi@ antinode-line % ] 2with each-pair ] { } make ;

: all-p2-antinode-coords ( grid signals -- coords ) [ [ dup [ length ] [ first length ] bi ] dip all-p2-antinode-coords-for-signal [ first2 rot valid-grid-index 3nip ] with filter ] with map V{ } clone [ combine-no-dup ] reduce ;

: solve-day-eight-part-two ( grid -- antinode-count ) dup signals all-p2-antinode-coords length ;
Author:	Leo Mehraban
Mode:	factor
Date:	Fri, 13 Dec 2024 14:44:10