Paste: My attempt at AOC part 13 (half a year later)

! day 15
! from day 4
!  : iterate-through-everything ( ... grid quot: ( ... x y grid -- ... ) -- ... ) over first length [ -rot over length [ -roll call ] 3with each-integer ] 2with each-integer ; inline  
!  ! : at-coord ( x y grid -- val ) swapd nth nth ;
! from day 8
! : by-cols ( grid -- cols ) [ first length ] keep [ [ nth ] with map ] curry map-integers ;
SYMBOLS: day15-robot wall box move-up move-down move-left move-right box-left box-right ;
: try-moving-forwards-along ( col idx -- col ) 
    cut wall over index [ cut ] [ { } ] if* [ [ [ not ] find ] keep rot [ cut rest append swap prefix ] [ nip ] if* ] dip append append ;
: robot-try-moving-forwards ( grid -- grid ) 
     dup [ day15-robot swap index ] find drop swap >vector [ [ day15-robot over index try-moving-forwards-along ] change-nth ] keep >array ;
: set-at-coord ( val x y grid -- grid ) swapd >vector [ [ >vector [ set-nth ] keep >array ] change-nth ] keep >array ;
DEFER: ?push-forwards-recursive
:: ?(push-forwards-recursive) ( grid x y add-left -- grid ? ) 
            grid x y [ 
                [ [ add-left + ] dip 1 + ?push-forwards-recursive tuck ? ]
                [ rot [ -rot [ add-left 1 + + ] dip 1 + ?push-forwards-recursive tuck ? ] [ 2drop f ] if* ]
                2bi 
            ] 3keep
            roll
            [
                [ drop ] 3dip -rot
                {
                    [ rot f -roll [ add-left + ] 2dip set-at-coord ]
                    [ rot f -roll [ add-left 1 + + ] 2dip set-at-coord ]
                    [ rot box-left -roll [ add-left + ] 2dip [ 1 + ] dip set-at-coord ]
                    [ rot box-right -roll [ add-left 1 + + ] 2dip [ 1 + ] dip set-at-coord ]
                } 2cleave t
            ] 
            [ 2drop f ] if* ;
: ?push-forwards-recursive ( grid x y -- grid ? ) 
    3dup rot at-coord
    {
        { wall [ 2drop f ] }
        { f [ 2drop t ] }
        { box-right [ -1 ?(push-forwards-recursive) ] }
        { box-left [ 0 ?(push-forwards-recursive) ] }
        {
            day15-robot
            [
                [ 1 + ?push-forwards-recursive ] 2keep
                rot 
                [
                    
                        [ rot f -roll set-at-coord ]
                        [ rot day15-robot -roll [ 1 + ] dip set-at-coord ]
                        2bi t
                ] 
                [ 2drop f ] if
            ]
        }
    } case ;
: p2-robot-try-moving-forwards ( grid -- grid ) 
    dup [ day15-robot swap index ] find day15-robot swap index ?push-forwards-recursive drop ;
: orient-grid ( grid direction -- grid )
    {
        { move-up [ [ reverse ] map ] }
        { move-down [ ] }
        { move-left [ by-cols [ reverse ] map ] }
        { move-right [ by-cols ] } ! actually by-rows, I'm just re-using by-cols because the code is the same
    } case ;
: disorient-grid ( grid direction -- grid )
    {
        { move-up [ [ reverse ] map ] }
        { move-down [ ] }
        { move-left [ [ reverse ] map by-cols ] }
        { move-right [ by-cols ] } ! actually by-rows, I'm just re-using by-cols because the code is the same
    } case ;
: p2-robot-try-moving ( grid direction -- grid )
    {
        { move-up [ [ reverse ] map p2-robot-try-moving-forwards [ reverse ] map ] }
        { move-down [ p2-robot-try-moving-forwards ] }
        { move-left [ by-cols [ reverse ] map robot-try-moving-forwards [ reverse ] map by-cols ] }
        { move-right [ by-cols robot-try-moving-forwards by-cols ] }
    } case ;
: robot-try-moving ( grid direction -- grid ) 
    [ orient-grid robot-try-moving-forwards ] keep disorient-grid ;
: parse-day-fifteen-input ( input -- grid directions ) 
    split-lines { "" } split first2 concat >array 
    [ H{ { CHAR: ^ move-up } { CHAR: v move-down } { CHAR: < move-left } { CHAR: > move-right } } at ] map
    [ [ >array [ H{ { CHAR: O box } { CHAR: @ day15-robot } { CHAR: # wall } { CHAR: . f } } at ] map ] map by-cols ] dip ;
: parse-day-fifteen-part-two ( input -- grid directions ) 
    parse-day-fifteen-input 
    [ by-cols [ [ H{ { box { box-left box-right } } { day15-robot { day15-robot f } } { wall { wall wall } } { f { f f } } } at ] map concat ] map by-cols ] dip ;
: print-day-fifteen-grid ( grid -- ) 
    by-cols
    [ 
        [ H{ { box CHAR: O } { day15-robot CHAR: @ } { wall CHAR: #  } { f CHAR: . } { box-left CHAR: [ } { box-right CHAR: ] } } at 1string write ] each nl 
    ] each ;
: count-gps ( grid -- # ) 0 swap [ [ at-coord { box box-left } index ] 2keepd rot [ 100 * + + ] [ 2drop ] if ] iterate-through-everything ;
: solve-day-fifteen ( input -- result ) parse-day-fifteen-input [ robot-try-moving ] each count-gps ;
: solve-day-fifteen-part-two ( input -- result ) parse-day-fifteen-part-two [ p2-robot-try-moving ] each count-gps ;
Author:	Leo Mehraban
Mode:	factor
Date:	Mon, 18 Aug 2025 22:35:51