! ugly
! Copyright (C) 2017 Your name.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors aoc.2017.10 arrays assocs io.binary kernel math
math.bits math.bitwise math.parser math.vectors path-finding
sequences sets ;
IN: aoc.2017.14
CONSTANT: input "hxtvlmkl"
: pp1 ( str -- n )
128 [
number>string "-" glue
p2 hex-string>bytes be> bit-count
] with map-sum ;
: bfs ( from assoc -- visited )
[ [ f ] dip find-path drop ] keep in-closed-set>> ;
: count-connected ( assoc -- n )
[ 0 ] dip [ keys empty? ] [
[ [ keys first ] keep bfs members ]
[ [ delete-at ] curry each ] bi
1 +
] bi-curry until ;
: make-set ( str -- set )
HS{ } clone [
swap 128 [
[ number>string "-" glue
p2 hex-string>bytes be> make-bits ] keep
[ [ 2array swap adjoin ] 3curry when ] curry with each-index
] with with each
] keep ;
CONSTANT: neighbour-vecs { { 0 1 } { 1 0 } { -1 0 } { 0 -1 } }
: add-neighbours ( assoc elem set -- )
swap [ neighbour-vecs [ v+ ] with map [ swap in? ] with filter ]
[ rot set-at ] bi ;
: make-assoc ( set -- neighbours )
H{ } clone [
swap [ members ] keep [
add-neighbours
] curry with each
] keep ;
: pp2 ( str -- n )
make-set make-assoc count-connected ;