! 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 ;