! day 12 ! from day 4 solution: ! : 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 solution: ! : by-cols ( grid -- cols ) [ first length ] keep [ [ nth ] with map ] curry map-integers ; : adjecent-to-one? ( x1 y1 x2 y2 -- ? ) swapd [ - abs ] 2bi@ + >float 1.0 = ; : adjecent-to? ( others x y -- ? ) [ [ first2 ] 2dip adjecent-to-one? ] 2curry find nip ; : any-adjecent-to? ( regions region -- ? ) [ first2 adjecent-to? ] cartesian-find drop ; : count-adjecent ( others x y -- n ) [ [ first2 ] 2dip adjecent-to-one? ] 2curry filter length ; : excluding ( seq n -- seq ) [ head ] [ 1 + tail ] 2bi append ; : pop-start ( seq -- elt ) [ first ] [ 0 swap remove-nth! drop ] bi ; : regions-from-coords ( coords -- regions ) >vector [ 1vector ] map 0 [ over length [ dup pop-start 2dup any-adjecent-to? [ swap append! drop t ] [ suffix! f ] if* ] [ swap [ drop 0 ] [ 1 + ] if ] [ dupd < ] tri* ] loop drop ; : generate-sides ( others x y -- sides ) [ { [ [ [ 1 + ] dip 2array swap index not ] 2keep rot [ [ 0.1 + ] dip 2array ] [ 2drop f ] if ] [ [ [ 1 - ] dip 2array swap index not ] 2keep rot [ [ 0.1 - ] dip 2array ] [ 2drop f ] if ] [ [ 1 + 2array swap index not ] 2keep rot [ 0.1 + 2array ] [ 2drop f ] if ] [ [ 1 - 2array swap index not ] 2keep rot [ 0.1 - 2array ] [ 2drop f ] if ] } 3cleave ] output>array sift ; : generate-side-regions ( region -- side-regions ) dup V{ } clone [ first2 generate-sides append! ] with reduce regions-from-coords ; : region-number ( region -- number ) [ length ] keep dup 0 [ first2 count-adjecent 4 swap - + ] with reduce * ; : pt2-region-number ( region -- number ) [ length ] keep generate-side-regions length * ; : grid-to-regions ( grid -- regions ) H{ } clone [ [ [ [ at-coord ] 2keepd 2array swap ] dip push-at ] curry iterate-through-everything ] keep V{ } clone [ nip regions-from-coords append! ] assoc-reduce >array ; : grid-to-solution ( grid -- number ) grid-to-regions [ region-number ] map sum ; : grid-to-pt2-solution ( grid -- number ) grid-to-regions [ pt2-region-number ] map sum ; : parse-day-twelve-input ( string -- grid ) split-lines harvest by-cols ; : solve-day-twelve ( string -- number ) parse-day-twelve-input grid-to-solution ; : solve-day-twelve-part-two ( string -- number ) parse-day-twelve-input grid-to-pt2-solution ;