Paste: My attempt at AOC day 4

! day 4

: at-coord ( x y grid -- val ) swapd nth nth ;

: at-coord-from-end ( x y grid -- val ) tuck [ [ length 1 - swap - ] [ first length 1 - swap - ] 2bi* ] keep at-coord  ;

: valid-grid-index ( x y grid -- x y grid ? ) [ tuck [ length [ < ] [ drop 0 >= ] 2bi and ] [ first length [ < ] [ drop 0 >= ] 2bi and ] 2bi* and ] 3check ;

! seemingly, the longest diagonal in a m*n grid is the length of either n or m, whichever is smaller
: shortest-len ( grid -- len ) [ first length ] [ length ] bi min ;

: ltr-diags ( grid -- diags )
    dup [ length ] keep
    [ dup shortest-len
      [
          swap [ [ + ] keep ] dip valid-grid-index [ at-coord ] [ 3drop f ] if
      ] 2with map-integers sift >string
    ] curry map-integers
    [ [ first length 1 - ] keep
      [ [ 1 + ] dip dup shortest-len
      [
          swap [ [ + ] keep ] dip swapd valid-grid-index [ at-coord ] [ 3drop f ] if
      ] 2with map-integers sift >string
    ] curry map-integers ] dip append ;

: rtl-diags ( grid -- diags )
    dup [ length ] keep
    [ dup shortest-len
      [
          swap [ [ - ] keep ] dip valid-grid-index [ at-coord ] [ 3drop f ] if
      ] 2with map-integers sift >string
    ] curry map-integers
    [ [ first length 1 - ] keep
      [ dup shortest-len
      [
          swap [ [ - ] keep ] dip swapd valid-grid-index [ at-coord-from-end ] [ 3drop f ] if
      ] 2with map-integers sift >string
    ] curry map-integers ] dip append ;

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

: backwards ( grid -- grid ) [ reverse ] map ;

: count-xmas ( grid -- num ) 0 [ "XMAS" subseq-indices length + ] reduce ;

: count-all-xmas ( grid -- num ) [ {
            [ count-xmas ]
            [ backwards count-xmas ]
            [ by-rows count-xmas ]
            [ by-rows backwards count-xmas ]
            [ ltr-diags count-xmas ]
            [ ltr-diags backwards count-xmas ]
            [ rtl-diags count-xmas ]
            [ rtl-diags backwards count-xmas ]
        } cleave ] output>array ;

: parse-day-four-string ( string -- grid ) split-lines harvest by-rows ;

: can-fit-x? ( x y grid -- ? ) [ {
            [ [ [ 1 + ] [ 1 + ] bi* ] dip valid-grid-index ]
            [ [ [ 1 + ] [ 1 - ] bi* ] dip valid-grid-index ]
            [ [ [ 1 - ] [ 1 - ] bi* ] dip valid-grid-index ]
            [ [ [ 1 - ] [ 1 + ] bi* ] dip valid-grid-index ] } 3cleave ] output>array [ ] all? ;

: first-forward-mas? ( x y grid -- ? )
   [ [ [ 1 + ] [ 1 + ] bi* ] dip at-coord CHAR: M = ]
   [ at-coord CHAR: A = ]
   [ [ [ 1 - ] [ 1 - ] bi* ] dip at-coord CHAR: S = ]
    3tri and and ;

: first-backwards-mas? ( x y grid -- ? )
   [ [ [ 1 - ] [ 1 - ] bi* ] dip at-coord CHAR: M = ]
   [ at-coord CHAR: A = ]
   [ [ [ 1 + ] [ 1 + ] bi* ] dip at-coord CHAR: S = ]
    3tri and and ;

: second-forward-mas? ( x y grid -- ? )
   [ [ [ 1 + ] [ 1 - ] bi* ] dip at-coord CHAR: M = ]
   [ at-coord CHAR: A = ]
   [ [ [ 1 - ] [ 1 + ] bi* ] dip at-coord CHAR: S = ]
    3tri and and ;

: second-backwards-mas? ( x y grid -- ? )
   [ [ [ 1 - ] [ 1 + ] bi* ] dip at-coord CHAR: M = ]
   [ at-coord CHAR: A = ]
   [ [ [ 1 + ] [ 1 - ] bi* ] dip at-coord CHAR: S = ]
    3tri and and ;

: 3with ( param1 param2 param3 obj quot: ( ..a -- ..b ) -- obj curried ) with with with ; inline

: is-mas? ( x y grid -- ? ) 3dup can-fit-x? [ [ [ first-forward-mas? ] [ first-backwards-mas? ] 3bi or ] [ [ second-forward-mas? ] [ second-backwards-mas? ] 3bi or ] 3bi and ] [ 3drop f ] if ;

: iterate-through-everything ( ... grid quot: ( ... x y grid -- ... ) -- ... ) over first length [ -rot over length [ -roll call ] 3with each-integer ] 2with each-integer  ; inline

: count-mas ( grid -- num ) 0 swap [ is-mas? [ 1 + ] when ] iterate-through-everything  ;