Day 8

AdventOfCode > 2022

Part 1: Consider your map; how many trees are visible from outside the grid?

I manually downloaded my personal day 8 input file as a logged user, and here I get the data in a more appropriate shape.

library(tidyverse)

── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
✔ ggplot2 3.4.0          ✔ purrr   0.3.5     
✔ tibble  3.1.8          ✔ dplyr   1.0.10    
✔ tidyr   1.2.1          ✔ stringr 1.5.0.9000
✔ readr   2.1.3          ✔ forcats 0.5.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()

library(slider)

make_grid <- function(df, var = "line") {
    var <- sym(var)
    df %>% 
        transmute(value = stringr::str_split(!!var, "")) %>% 
        mutate(row = row_number()) %>% 
        unnest_longer(value, indices_to = "col") %>% 
        mutate(value = as.integer(value))
}

data <- here::here("2022/08_input") %>% 
    read_csv(
      col_names = c("line"),
      show_col_types = FALSE
    ) %>% 
    make_grid()

data

# A tibble: 9,801 × 3
   value   col   row
   <int> <int> <int>
 1     0     1     1
 2     0     2     1
 3     1     3     1
 4     0     4     1
 5     1     5     1
 6     2     6     1
 7     0     7     1
 8     0     8     1
 9     2     9     1
10     3    10     1
# … with 9,791 more rows

When having this input:

30373
25512
65332
33549
35390

We expect this output: 21 trees visible (16 trees visible on the edge and 5 in the interior)

• All of the trees around the edge of the grid are visible
• The top-left 5 is visible from the left and top.
• The top-middle 5 is visible from the top and right.
• The top-right 1 is not visible from any direction.
• The left-middle 5 is visible, but only from the right.
• The center 3 is not visible from any direction; for it to be visible, there would need to be only trees of at most height 2 between it and an edge.
• The right-middle 3 is visible from the right.
• In the bottom row, the middle 5 is visible, but the 3 and 4 are not.

visible_vec <- function(line) {
  line %>% accumulate(max) %>% lag(default = -1)
}

is_visible <- function(line) {
  line > visible_vec(line)
}
  
test <-
  tribble(
      ~line,
      "30373",
      "255122",
      "65332",
      "33549",
      "35390"
    ) %>% 
    make_grid()


test %>% 
  group_by(col) %>% 
  mutate(top = is_visible(value)) %>% 
  group_by(row) %>% 
  mutate(left = is_visible(value)) %>% 
  filter(row == 2, col == 2)

# A tibble: 1 × 5
# Groups:   row [1]
  value   col   row top   left 
  <int> <int> <int> <lgl> <lgl>
1     5     2     2 TRUE  TRUE 

test %>% 
  group_by(col) %>% 
  mutate(top = is_visible(value)) %>% 
  group_by(row) %>% 
  mutate(left = is_visible(value)) %>% 
  mutate(right = rev(is_visible(rev(value)))) %>% 
  filter(row == 2, col == 3)

# A tibble: 1 × 6
# Groups:   row [1]
  value   col   row top   left  right
  <int> <int> <int> <lgl> <lgl> <lgl>
1     5     3     2 TRUE  FALSE TRUE 

test %>% 
  group_by(col) %>% 
  mutate(top = is_visible(value)) %>% 
  mutate(bottom = rev(is_visible(rev(value)))) %>% 
  group_by(row) %>% 
  mutate(left = is_visible(value)) %>% 
  mutate(right = rev(is_visible(rev(value)))) %>% 
  filter(row == 4, col == 3)

# A tibble: 1 × 7
# Groups:   row [1]
  value   col   row top   bottom left  right
  <int> <int> <int> <lgl> <lgl>  <lgl> <lgl>
1     5     3     4 FALSE TRUE   TRUE  FALSE

The result: 1832

data %>% 
  group_by(col) %>% 
  mutate(top = is_visible(value)) %>% 
  mutate(bottom = rev(is_visible(rev(value)))) %>% 
  group_by(row) %>% 
  mutate(left = is_visible(value)) %>% 
  mutate(right = rev(is_visible(rev(value)))) %>% 
  ungroup() %>% 
  mutate(visible = top + bottom + left + right) %>% 
  summarise(visible = sum(visible > 0))

# A tibble: 1 × 1
  visible
    <int>
1    1832

Part 2: Consider each tree on your map. What is the highest scenic score possible for any tree?

In the example above, consider the middle 5 in the second row:

30373
25512
65332
33549
35390

• Looking up, its view is not blocked; it can see 1 tree (of height 3).
• Looking left, its view is blocked immediately; it can see only 1 tree (of height 5, right next to it).
• Looking right, its view is not blocked; it can see 2 trees.
• Looking down, its view is blocked eventually; it can see 2 trees (one of height 3, then the tree of height 5 that blocks its view).

A tree’s scenic score is found by multiplying together its viewing distance in each of the four directions. For this tree, this is 4 (found by multiplying 1 * 1 * 2 * 2).

I build helper functions to get the cell for each direction:

direcctions_up <- function(df, x, y) {
  df %>% filter(row < x, col == y) %>% pull(value) %>% rev() %>% list()
}
direcctions_down <- function(df, x, y) {
  df %>% filter(row > x, col == y) %>% pull(value) %>% list()
}
direcctions_right <- function(df, x, y) {
  df %>% filter(row == x, col > y) %>% pull(value) %>% list()
}
direcctions_left <- function(df, x, y) {
  df %>% filter(row == x, col < y) %>% pull(value) %>% rev() %>% list()
}
test %>% 
  filter(row == 3, col == 3) %>% 
  mutate(up = direcctions_up(test, row, col)) %>% 
  mutate(down = direcctions_down(test, row, col)) %>% 
  mutate(right = direcctions_right(test, row, col)) %>% 
  mutate(left = direcctions_left(test, row, col)) %>% 
  select(up, down, right, left) %>% 
  as.list()

$up
$up[[1]]
[1] 5 3


$down
$down[[1]]
[1] 5 3


$right
$right[[1]]
[1] 3 2


$left
$left[[1]]
[1] 5 6

I build a helper function to compute the distance for each direction:

distances <- function(value, row, col, up, left, down, right) {
    # print(paste("distances:", row, col))
    d_up <- d_down <- d_right <- d_left <- 0
    if (length(up) > 0) d_up <- value > visible_vec(unlist(up))
    if (length(left) > 0) d_left <- value > visible_vec(unlist(left))
    if (length(down) > 0) d_down <- value > visible_vec(unlist(down))
    if (length(right) > 0) d_right <- value > visible_vec(unlist(right))
    list(c(sum(d_up), sum(d_left), sum(d_down), sum(d_right)))
  }


test %>% 
  rowwise() %>% 
  filter(row == 4, col == 3) %>% 
  mutate(up = direcctions_up(test, row, col)) %>% 
  mutate(down = direcctions_down(test, row, col)) %>% 
  mutate(right = direcctions_right(test, row, col)) %>% 
  mutate(left = direcctions_left(test, row, col)) %>% 
  mutate(distances = distances(value, row, col, up, left, down, right)) %>% 
  ungroup() %>% 
  as.list()

$value
[1] 5

$col
[1] 3

$row
[1] 4

$up
$up[[1]]
[1] 3 5 3


$down
$down[[1]]
[1] 3


$right
$right[[1]]
[1] 4 9


$left
$left[[1]]
[1] 3 3


$distances
$distances[[1]]
[1] 2 2 1 2

Here the test results:

# options(max.print = 10000)
test %>% 
  rowwise() %>% 
  mutate(up = direcctions_up(test, row, col)) %>% 
  mutate(down = direcctions_down(test, row, col)) %>% 
  mutate(right = direcctions_right(test, row, col)) %>% 
  mutate(left = direcctions_left(test, row, col)) %>% 
  mutate(distances = distances(value, row, col, up, left, down, right)) %>% 
  mutate(scenic_score = prod(distances)) %>% 
  arrange(-scenic_score)

# A tibble: 26 × 9
# Rowwise: 
   value   col   row up        down      right     left      distances scenic_…¹
   <int> <int> <int> <list>    <list>    <list>    <list>    <list>        <dbl>
 1     5     3     4 <int [3]> <int [1]> <int [2]> <int [2]> <int [4]>         8
 2     5     3     2 <int [1]> <int [3]> <int [3]> <int [2]> <int [4]>         6
 3     5     2     3 <int [2]> <int [2]> <int [3]> <int [1]> <int [4]>         6
 4     4     4     4 <int [3]> <int [1]> <int [1]> <int [3]> <int [4]>         3
 5     2     5     2 <int [1]> <int [3]> <int [1]> <int [4]> <int [4]>         2
 6     3     4     3 <int [2]> <int [2]> <int [1]> <int [3]> <int [4]>         2
 7     5     2     2 <int [1]> <int [3]> <int [4]> <int [1]> <int [4]>         1
 8     1     4     2 <int [1]> <int [3]> <int [2]> <int [3]> <int [4]>         1
 9     3     3     3 <int [2]> <int [2]> <int [2]> <int [2]> <int [4]>         1
10     3     2     4 <int [3]> <int [1]> <int [3]> <int [1]> <int [4]>         1
# … with 16 more rows, and abbreviated variable name ¹​scenic_score

Here one example from my data:

ret <-  data %>% 
  filter(row == 43, col == 48) %>% 
  mutate(up = direcctions_up(data, row, col)) %>% 
  mutate(down = direcctions_down(data, row, col)) %>% 
  mutate(right = direcctions_right(data, row, col)) %>% 
  mutate(left = direcctions_left(data, row, col)) %>% 
  mutate(distances = distances(
    value, row, col, up, left, down, right
  )) %>% 
  as.list()
ret

$value
[1] 9

$col
[1] 48

$row
[1] 43

$up
$up[[1]]
 [1] 7 6 8 7 7 8 7 8 8 8 7 8 8 4 8 4 8 5 6 4 7 6 3 6 4 4 5 5 3 4 4 6 5 3 3 2 3 1
[39] 3 4 4 2


$down
$down[[1]]
 [1] 8 7 7 9 8 8 7 7 8 8 8 7 7 9 9 7 8 7 6 8 6 6 8 6 5 8 5 9 5 6 7 5 8 4 8 4 6 7
[39] 7 3 7 3 4 2 5 2 4 4 3 3 6 3 5 4 2 5


$right
$right[[1]]
 [1] 6 8 7 8 7 6 9 7 6 9 9 7 8 6 6 6 5 5 7 6 5 9 7 8 8 6 5 4 7 7 4 3 3 7 4 6 6 6
[39] 4 5 6 2 6 4 6 1 4 2 2 1 2


$left
$left[[1]]
 [1] 8 9 7 8 7 8 8 8 7 8 7 7 5 7 5 9 8 8 4 4 6 5 7 6 3 5 5 7 5 5 5 5 2 5 6 2 2 2
[39] 4 3 5 2 2 1 5 2 4


$distances
$distances[[1]]
[1] 42  2  4  7

Here the results for most probable winner:

tictoc::tic("scores")
scores <- data %>% 
  filter(value > 5) %>% 
  rowwise() %>% 
  mutate(up = direcctions_up(data, row, col)) %>% 
  mutate(down = direcctions_down(data, row, col)) %>% 
  mutate(right = direcctions_right(data, row, col)) %>% 
  mutate(left = direcctions_left(data, row, col)) %>% 
  mutate(distances = distances(
    value, row, col, up, left, down, right
  )) %>% 
  mutate(scenic_score = prod(distances)) %>% 
  arrange(-scenic_score)
head(scores)

# A tibble: 6 × 9
# Rowwise: 
  value   col   row up         down       right      left       distan…¹ sceni…²
  <int> <int> <int> <list>     <list>     <list>     <list>     <list>     <dbl>
1     8    24    61 <int [60]> <int [38]> <int [75]> <int [23]> <int>     157320
2     8    25    60 <int [59]> <int [39]> <int [74]> <int [24]> <int>     146016
3     6    48    94 <int [93]> <int [5]>  <int [51]> <int [47]> <int>     119850
4     8    78    41 <int [40]> <int [58]> <int [21]> <int [77]> <int>     114240
5     7    15    52 <int [51]> <int [47]> <int [84]> <int [14]> <int>     100674
6     8    46    29 <int [28]> <int [70]> <int [53]> <int [45]> <int>      95400
# … with abbreviated variable names ¹​distances, ²​scenic_score

tictoc::toc()

scores: 76.494 sec elapsed

Solution

library(tidyverse)
library(slider)

make_grid <- function(df, var = "line") {
    var <- sym(var)
    df %>% 
        transmute(value = stringr::str_split(!!var, "")) %>% 
        mutate(row = row_number()) %>% 
        unnest_longer(value, indices_to = "col") %>% 
        mutate(value = as.integer(value))
}

data <- here::here("2022/08_input") %>% 
    read_csv(
      col_names = c("line"),
      show_col_types = FALSE
    ) %>% 
    make_grid()

visible_vec <- function(line) {
  line %>% accumulate(max) %>% lag(default = -1)
}

is_visible <- function(line) {
  line > visible_vec(line)
}

data %>% 
  group_by(col) %>% 
  mutate(top = is_visible(value)) %>% 
  mutate(bottom = rev(is_visible(rev(value)))) %>% 
  group_by(row) %>% 
  mutate(left = is_visible(value)) %>% 
  mutate(right = rev(is_visible(rev(value)))) %>% 
  ungroup() %>% 
  mutate(visible = top + bottom + left + right) %>% 
  summarise(visible = sum(visible > 0))

direcctions_up <- function(df, x, y) {
  df %>% filter(row < x, col == y) %>% pull(value) %>% rev() %>% list()
}
direcctions_down <- function(df, x, y) {
  df %>% filter(row > x, col == y) %>% pull(value) %>% list()
}
direcctions_right <- function(df, x, y) {
  df %>% filter(row == x, col > y) %>% pull(value) %>% list()
}
direcctions_left <- function(df, x, y) {
  df %>% filter(row == x, col < y) %>% pull(value) %>% rev() %>% list()
}

distances <- function(value, row, col, up, left, down, right) {
    d_up <- d_down <- d_right <- d_left <- 0
    if (length(up) > 0) d_up <- value > visible_vec(unlist(up))
    if (length(left) > 0) d_left <- value > visible_vec(unlist(left))
    if (length(down) > 0) d_down <- value > visible_vec(unlist(down))
    if (length(right) > 0) d_right <- value > visible_vec(unlist(right))
    list(c(sum(d_up), sum(d_left), sum(d_down), sum(d_right)))
  }

tictoc::tic("scores")
scores <- data %>% 
  filter(value > 5) %>% 
  rowwise() %>% 
  mutate(up = direcctions_up(data, row, col)) %>% 
  mutate(down = direcctions_down(data, row, col)) %>% 
  mutate(right = direcctions_right(data, row, col)) %>% 
  mutate(left = direcctions_left(data, row, col)) %>% 
  mutate(distances = distances(
    value, row, col, up, left, down, right
  )) %>% 
  mutate(scenic_score = prod(distances)) %>% 
  arrange(-scenic_score)
head(scores)
tictoc::toc()