Paste: AoC 2022 Day 14

! 2022 nomennescio
USING: arrays assocs io.encodings.utf8 io.files kernel make math math.parser math.vectors multiline namespaces prettyprint ranges sequences splitting ;
IN: aoc2022

<<
ALIAS: ' CHAR:
>>

: parse-line ( line -- pairs ) " -> " split-subseq [ "," split [ dec> ] map ] map ;
: parse-file ( path encoding -- paths ) file-lines [ parse-line ] map ;
: draw-line ( from to -- ) [ first2 ] bi@ swapd [ [a..b] ] 2bi@ [ over [ over 2array ' # swap ,, ] each drop ] each drop ;
: draw-rocks ( paths -- grid-assoc ) [ [ unclip swap [ tuck draw-line ] each drop ] each ] H{ } make ;

CONSTANT: origin { 500 0 }
SYMBOL: cave

: bottom ( grid-assoc -- n ) keys [ second ] map supremum ;
: grains ( -- n ) cave get values [ ' o = ] count ;
: air? ( pos -- ? ) cave get at* not nip ;
: fall ( pos -- pos' fell? ) { 0 1 } v+ dup air? [ t ] [ { -1 0 } v+ dup air? [ t ] [ { 2 0 } v+ dup air? [ t ] [ { -1 -1 } v+ ' o over cave get set-at f ] if ] if ] if ;
: run-grain ( bottom pos -- bottom pos' fell? ) fall dup [ 2over second > [ drop run-grain ] when ] when ;
: run-sand ( bottom -- ) origin run-grain [ 2drop ] [ drop run-sand ] if ;
: run-sand-floor ( floor -- ) origin run-grain [ ' o over cave get set-at ] when origin = [ drop ] [ run-sand-floor ] if ;
: part1 ( bottom -- n ) run-sand grains ;
: part2 ( floor -- n ) run-sand-floor grains ;

CONSTANT: file "input-14.txt"

: day14 ( -- ) file utf8 parse-file draw-rocks dup cave set [ bottom part1 . ] [ bottom 1 + part2 . ] bi ;

MAIN: day14