# Paste: AoC Day 08

Author: CapitalEx factor Thu, 8 Dec 2022 20:18:24
Plain Text |
```USING: accessors advent-of-code.utils arrays assocs combinators
combinators.smart generalizations io.backend io.encodings.utf8
io.files kernel math math.matrices math.parser math.statistics
sequences sequences.deep sets splitting strings ;

: get-input-one ( -- seq )
normalize-path utf8 file-contents ;

! Words for constructing grids used to process input
: make-grid ( input -- grid )
split-lines [ [ 1string dec> ] { } map-as ] map ;

: grid-dims ( grid -- x y )
[ first length ] [ length ] bi ;

: position-grid ( grid -- grid )
grid-dims [ <iota> ] bi@ cartesian-product ;

: 2d-pair ( grid grid -- grid )
swap [ zip [ rest-slice ] map ] 2map ;

: paired-grid ( grid -- grid )
dup position-grid 2d-pair ;

! Words for computing how many trees can be seen from the outside.
: visible-trees ( row -- visible )
cum-max reverse fast-set ;

: left   ( grid -- left   ) [ visible-trees ]         map ;
: right  ( grid -- right  ) [ reverse visible-trees ] map ;
: top    ( grid -- top    ) transpose  left ;
: bottom ( grid -- bottom ) transpose right ;

: tree-lines ( grid -- trees )
{ [ left ] [ right ] [ top ] [ bottom ] } cleave 4array ;

: all-members ( seq -- seq )
flatten [ members ] map flatten1 ;

: get-positions ( seq -- seq )
[ seq>> first ] map ;

: unique-trees ( trees -- unique )
all-members get-positions fast-set members ;

! Solve problem one
: solve-part-one ( -- solution )
get-input-one make-grid
paired-grid   tree-lines
unique-trees  length
;

! Implement solution for part two
! Not much I did in part one could be reused

! Find trees in row
: look-left ( grid position -- seq )
first2 exhume nth swap 1 + head reverse ;

: look-right ( grid position -- seq )
first2 exhume nth swap tail ;

: look-up ( grid position -- seq )
[ transpose ] [ reverse ] bi* look-left ;

: look-down ( grid position -- seq )
[ transpose ] [ reverse ] bi* look-right ;

: look ( grid position -- left right up down )
{
[ look-left ]
[ look-right ]
[ look-up ]
[ look-down ]
} 2cleave ;

! Comput scores
: fix-length ( seq ? -- length )
[ nip ] [ length 1 - ] if* ;

: run-length ( row -- n )
dup [ 1 ] dip dup first '[ _ >= ] find-from drop fix-length ;

: score ( left right up down -- score )
[ run-length ] 4 napply * * * ;

: scenic-score ( grid position -- score )
look score ;

: scenic-scores ( grid -- scores )
dup position-grid flatten1 [ scenic-score ] with map ;

! Solve puzzle
: solve-part-two ( -- solution )
get-input-one make-grid
scenic-scores supremum
;```