! 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 ;