!- very ugly :( ! Copyright (C) 2018 Your name. ! See http://factorcode.org/license.txt for BSD license. USING: arrays assocs combinators combinators.short-circuit.smart deques dlists io.encodings.ascii io.files kernel locals math math.parser math.statistics math.vectors prettyprint sequences sets splitting ; IN: aoc6 : get-bounds ( seq -- topleft bottomright ) { [ [ first ] map infimum ] [ [ last ] map infimum ] [ [ first ] map supremum ] [ [ last ] map supremum ] } cleave [ 2array ] 2bi@ ; : neighbours ( pos -- seq ) { { 0 1 } { 1 0 } { 0 -1 } { -1 0 } } [ v+ ] with map ; : manhattan ( x1 x2 -- d ) v- [ abs ] map-sum ; :: aoc6-1 ( -- n ) "/tmp/input" ascii file-lines [ ", " split [ first ] [ last ] bi 2array [ string>number ] map ] map :> in in get-bounds :> ( topleft bottomright ) in [ dup ] H{ } map>assoc :> prevs :> fifo in fifo push-all-back [ fifo deque-empty? ] [ fifo pop-back :> cur cur dup prevs at :> prev prev manhattan 1 + :> dist cur neighbours [ { [ topleft [ < ] 2map [ ] any? ] [ bottomright [ > ] 2map [ ] any? ] [| neighbour | neighbour prevs at* [ [ neighbour [ manhattan dist = ] [ drop prev and ] [ drop prev = not ] 2tri and and ] when [ f neighbour prevs set-at ] when ] keep ] } || ] reject [ [ prev swap prevs set-at ] [ fifo push-front ] bi ] each ] until prevs [ drop { [ topleft [ = ] 2map [ ] any? ] [ bottomright [ = ] 2map [ ] any? ] } || ] assoc-filter values sift fast-set :> borders prevs [ nip [ borders in? ] [ not ] bi or ] assoc-reject >alist [ second ] histogram-by >alist [ second ] map supremum ;