Paste: aoc20

USING: backtrack math.ranges ;
: left ( tile -- left ) [ first ] map ;
: right ( tile -- left ) [ last ] map ;
: top ( tile -- top ) first ;
: bottom ( tile -- bottom ) last ;
: all ( tile -- seq ) [
  dup flip
  dup reverse dup flip
  dup reverse dup flip
  dup reverse dup flip
] curry output>array [ [ >string ] map ] map ;

: choose-one ( tiles -- tile tiles' )
  [ amb-lazy ] keep over
  [ [ remove ] keepd all amb-lazy swap ] when ; 
: matching ( top right bottom left tiles -- tile tiles' )
  choose-one [ [
    [ 2dup and [ [ bottom ] [ top ] bi* = ] [ 2drop t ] if ] 
    [ 2dup and [ [ left ] [ right ] bi* = ] [ 2drop t ] if ] 
    [ 2dup and [ [ top ] [ bottom ] bi* = ] [ 2drop t ] if ] 
    [ 2dup and [ [ right ] [ left ] bi* = ] [ 2drop t ] if ]
    4 cleave-curry 4 spread* and and and [ fail ] unless
  ] keep ] dip ; 
: north ( pos -- pos' ) { -1 0 } v+ ;
: south ( pos -- pos' ) { 1 0 } v+ ;
: east ( pos -- pos' ) { 0 1 } v+ ;
: west ( pos -- pos' ) { 0 -1 } v+ ;
: neighbours ( pos -- poss )
{ { -1 0 } { 0 1 } { 1 0 } { 0 -1 } } [ v+ ] with map ;
: first-avail ( hash -- pos )
dup keys over [ at ] curry filter [ neighbours ] map concat members
[ vabs supremum ] sort-with swap [ at* nip not ] curry find nip ; 
cut-amb
"/home/harperjon/Téléchargements/input20" ascii file-lines
{ "" } split
[ rest ] map f suffix unclip
{ 0 0 } associate
[ over { f } = ] [ dup first-avail
  dup neighbours pick [ at ] curry map
  [ rot ] dip swap [ first4 ] dip matching
  [ rot swapd [ set-at ] keep ] dip swap
] until nip
>alist natural-sort
[ [ first first ] bi@ = ] monotonic-split
[ [ second ] map harvest ] map harvest

dup {
  [ first first ]  [ first last ]  [ last first ]  [ last last ]
} cleave 4array
"/home/harperjon/Téléchargements/input20" ascii file-lines
{ "" } split
[ unclip 2array ] map [
  [ first swap all in? ] with find nip second " :" split second string>number
] curry map product .

[ [ [ rest but-last ] map ] map ] map
[ [ rest but-last ] map ] map
[ flip ] map
[ [ concat ] map ] map concat
CONSTANT: seamonster {
"                  # "
"#    ##    ##    ###"
" #  #  #  #  #  #   "
}

: (seamonster?) ( a b -- ? )
  [ [ [ CHAR: # = ] [ CHAR: space = ] bi* or ] 2all? ] 2all? ;
: seamonster? ( image {i,j} -- ? )
    2dup swap [ length 3 - ] [ first length 20 - ] bi 2array [ <= ] 2all? 
[    first2 [ dup 1 + dup 1 + 3array swap nths ] dip
    [ dup 20 + [a,b) swap nths ] curry map seamonster (seamonster?) ] [ 2drop f ] if ;
[ concat [ CHAR: # = ] count ] 
[ all [
dup [ [ [ swap 2array nip ] dip swap seamonster? ] curry curry map-index ] curry map-index concat sift length
dup 0 > swap and ] map-find drop seamonster concat [ CHAR: # = ] count * ]
bi - .