Paste: AoC 2022 Day 12

! 2022 nomennescio
USING: accessors arrays io.encodings.utf8 io.files kernel math math.vectors multiline namespaces path-finding prettyprint sequences sequences.extras sequences.product ;
IN: aoc2022

<<
! Factor builds are out of date
SYNTAX: (( "))" parse-multiline-string drop ;
ALIAS: ` CHAR:
>>

SYMBOL: heightmap

TUPLE: xy { xy pair initial: { 0 0 } } ; ! 'initial:' should not be needed!
: <xy> ( x y -- xy ) 2array xy boa ;
: >xy< ( xy -- x y ) xy>> first2 ;

TUPLE: ic-astar < astar { hw xy } ;
: heightmap-size ( -- width height ) heightmap get [ first length ] [ length ] bi ;
: <ic-astar> ( -- astar ) heightmap-size <xy> ic-astar new swap >>hw ;

: find-xy ( char -- xy str ) heightmap get [ dupd member? ] find (( c y str )) swapd [ index swap <xy> ] keep ;
: find-set-xy ( char replace -- xy ) [ find-xy ] dip (( xy str r )) [ dup >xy< drop ] 2dip '[ drop _ ] change-nth ;
: parse-file ( path encoding -- start end ) file-lines heightmap set ` S ` a find-set-xy ` E ` z find-set-xy ;

: get-xy ( xy -- c ) >xy< heightmap get nth nth ;
M: ic-astar cost drop [ get-xy ] bi@ - -1 < 1/0. 1 ? ; inline

M: ic-astar heuristic drop [ xy>> ] bi@ v- l1-norm ; inline

CONSTANT: neighborhood { { -1 0 } { 1 0 } { 0 -1 } { 0 1 } }
M: ic-astar neighbors hw>> swap [ xy>> ] bi@ (( hw xy )) neighborhood [ over v+ xy boa ] [ xy>> [ { 0 0 } v>= vall? ] [ reach v< vall? ] bi and ] map-filter 2nip ; inline

CONSTANT: file "input-12.txt"

: part1 ( start end -- n ) <ic-astar> find-path dup [ length 1 - ] [ drop 1/0. ] if ; inline
! brute force part 2. Something more elegant would be to start from E and find a path to any 'a', but that's more work...
: part2 ( start end -- n ) nip heightmap-size [ <iota> ] bi@ 2array <product-sequence> [ xy boa ] [ get-xy ` a = ] map-filter [ over part1 ] map infimum nip ;
: day12 ( -- ) file utf8 parse-file [ part1 . ] [ part2 . ] 2bi ;

MAIN: day12