CONSTANT: depth 4002 CONSTANT: target { 5 746 } USE: math.distances DEFER: erosion-level : (geologic-index) ( pos -- n ) { { [ dup second zero? ] [ first 16807 * ] } { [ dup first zero? ] [ second 48271 * ] } [ { -1 0 } { 0 -1 } [ v+ erosion-level ] bi-curry@ bi * ] } cond ; : geologic-index ( pos -- n ) { { { 0 0 } [ 0 ] } ${ target [ 0 ] } [ (geologic-index) ] } case ; MEMO: erosion-level ( pos -- n ) geologic-index depth + 20183 mod ; : danger ( pos -- n ) erosion-level 3 mod ; : 22p1 ( -- ) 0 target first [a,b] [ 0 target second [a,b] [ 2array danger ] with map-sum ] map-sum . ; 22p1 TUPLE: cave-state state pos ; TUPLE: cave-astar < astar ; M: cave-astar cost drop [ state>> ] bi@ = 1 7 ? ; M: cave-astar heuristic drop [ [ pos>> ] bi@ manhattan-distance ] [ [ state>> ] bi@ = 0 7 ? ] 2bi + ; M: cave-astar neighbours drop [ { { -1 0 } { 1 0 } { 0 -1 } { 0 1 } } [ [ clone ] dip [ v+ ] curry change-pos ] with map [ pos>> [ 0 < ] any? ] reject [ [ state>> ] [ pos>> danger ] bi = ] reject ] [ { 0 1 2 } [ [ clone ] dip >>state ] with map [ [ state>> ] [ pos>> danger ] bi = ] reject ] bi append ; : 22p2 ( -- ) T{ cave-state f 1 { 0 0 } } T{ cave-state f 1 f } target >>pos cave-astar new [ find-path ] keep g>> [ over pprint " " write at . ] curry each ; 22p2