! 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