Paste: aoc6 part1

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