The completionist streak continues, despite ever-increasing puzzle difficulty and timelines. I’m finding myself more and more comfortable with using loops, despite previous hatred of them, and I think I’m being challenged to think about data structures and reducing my data structures to non-tibbles (i.e. matrices, vectors, lists) - which is faster to iterate over in large scale.

I’m also thinking about things like copy on modify, parallel processing, and recursion! (and an uncomfortable dose of regex).

Greatly enjoying it still, although I’m now limiting how long I stay up to 60-90 minutes.

## # A tibble: 5 x 5
##     day time_1   rank_1 time_2   rank_2
##   <dbl> <chr>     <dbl> <chr>     <dbl>
## 1    20 00:43:06    948 21:39:22   6404
## 2    19 01:23:47   2466 11:42:08   6929
## 3    18 11:24:51  13996 11:54:32  12112
## 4    17 01:45:32   4130 07:49:59   9588
## 5    16 00:24:42   2780 01:00:42   1869

Packages used

suppressPackageStartupMessages({
  library(tidyverse)
  library(here)
  library(furrr)
  library(lobstr)
  library(glue)
  
})

Day Sixteen

This one was pretty straightforward as a parse, clean, and map - felt lots better than day 15, but this would be quite rare for the next few days.

— Description —

Unfortunately, you can’t actually read the words on the ticket. You can, however, read the numbers, and so you figure out the fields these tickets must have and the valid ranges for values in those fields.

You collect the rules for ticket fields, the numbers on your ticket, and the numbers on other nearby tickets for the same train service (via the airport security cameras) together into a single document you can reference (your puzzle input).

— Data —

input_16 <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-16.txt")

— Cleaning —

Definitely a problem that would benefit from tidying. Also going to go ahead and create an integer vector for each rule range, which will facilitate %in% checks later.

x <- tibble(input = input_16) %>% 
  mutate(group = cumsum(input == ""))

rules <- x %>% 
  filter(group == 0) %>% 
  separate(input,c("rule","values"),sep = ": ") %>% 
  separate_rows(values, sep = " or ") %>% 
  separate(values,c("start_value","end_value"),sep = "-",convert = TRUE) %>% 
  mutate(range = map2(start_value,end_value,~.x:.y)) %>% 
  select(-group) %>% 
  group_by(rule) %>% 
  summarise(range = list(range))

your_ticket <- x %>% 
  filter(group == 1, input!="",input!="your ticket:") %>% 
  separate_rows(input, sep = ",", convert = TRUE) %>% 
  mutate(field_id = row_number()) %>% 
  select(-group)

other_tickets <- x %>% 
  filter(group == 2,input!="",input!="nearby tickets:") %>% 
  mutate(ticket_id = row_number()) %>% 
  separate_rows(input,sep = ",",convert = TRUE) %>% 
  select(-group)

— Problem 1 —

Start by determining which tickets are completely invalid; these are tickets that contain values which aren’t valid for any field. Ignore your ticket for now.

Consider the validity of the nearby tickets you scanned. What is your ticket scanning error rate?

rule_range <- rules$range %>% unlist() %>% unique()

check_invalid <- other_tickets %>% 
  mutate(check = input %in% rule_range) %>% 
  filter(!check)
head(check_invalid)
## # A tibble: 6 x 3
##   input ticket_id check
##   <int>     <int> <lgl>
## 1     8         2 FALSE
## 2     4        13 FALSE
## 3     3        23 FALSE
## 4    24        25 FALSE
## 5   979        29 FALSE
## 6   984        34 FALSE
sum(check_invalid$input)
## [1] 25895

— Problem 2 —

Using the valid ranges for each field, determine what order the fields appear on the tickets. The order is consistent between all tickets: if seat is the third field, it is the third field on every ticket, including your ticket.

Looks straightforward enough: filter out the ticket ids that are invalid, then create a field_id and summarise the values for each field_id as a vector.

valid_other <- other_tickets %>%
  filter(!ticket_id %in% check_invalid$ticket_id) %>% 
  group_by(ticket_id) %>% 
  mutate(field_id = row_number()) %>% 
  ungroup()

field_summary <- valid_other %>%
  arrange(input) %>% 
  group_by(field_id) %>% 
  summarise(values = list(input),
            min = min(input,na.rm = TRUE),
            max = max(input,na.rm = TRUE))
head(field_summary)
## # A tibble: 6 x 4
##   field_id values        min   max
##      <int> <list>      <int> <int>
## 1        1 <int [190]>    50   916
## 2        2 <int [190]>    55   946
## 3        3 <int [190]>    50   947
## 4        4 <int [190]>    60   945
## 5        5 <int [190]>    51   948
## 6        6 <int [190]>    52   947

We can check all fields against all rules with crossing, which’ll create one row for every rule x field - from there, run an %in% operator to check whether all values are in a range, and then filter to where these checks are TRUE. Then summarise this by the rule so that we can see what field_options there are for each rule

check_fields <- crossing(rules,field_summary) %>% 
  mutate(range = map(range,unlist)) %>% 
  mutate(check = map2_lgl(range,values,~all(.y %in% .x))) %>% 
  filter(check)

field_options <- check_fields %>% 
  group_by(rule) %>% 
  summarise(n = n(),field_id = list(field_id)) %>% 
  ungroup() %>% 
  arrange(n)
field_options
## # A tibble: 20 x 3
##    rule                   n field_id  
##    <chr>              <int> <list>    
##  1 arrival location       1 <int [1]> 
##  2 train                  2 <int [2]> 
##  3 arrival station        3 <int [3]> 
##  4 price                  4 <int [4]> 
##  5 arrival track          5 <int [5]> 
##  6 wagon                  6 <int [6]> 
##  7 route                  7 <int [7]> 
##  8 departure time         8 <int [8]> 
##  9 departure station      9 <int [9]> 
## 10 departure platform    10 <int [10]>
## 11 departure date        11 <int [11]>
## 12 departure location    12 <int [12]>
## 13 departure track       13 <int [13]>
## 14 duration              14 <int [14]>
## 15 type                  15 <int [15]>
## 16 arrival platform      16 <int [16]>
## 17 zone                  17 <int [17]>
## 18 seat                  18 <int [18]>
## 19 class                 19 <int [19]>
## 20 row                   20 <int [20]>

Inspecting these options, we can see that there’s only one option for arrival location, two options for train (one of which is the only option for arrival location), three options for arrival station (but two are in the previous etc) - and continuing the visual inspection shows this pattern carries forward for all twenty fields.

Writing a quick little loop here to assign the fields starting with the first one.

unassigned <- field_options

assigned <- tibble(rule = NULL, field_id = NULL)

while(nrow(unassigned)>0){
  
  assigned <- unassigned %>% 
    slice(1) %>% 
    bind_rows(assigned,.)
  
  unassigned <- unassigned %>% 
    tail(n = -1) %>% 
    mutate(field_id = map(field_id, ~.x[!.x %in% assigned$field_id]))
  
}
your_assignment <- assigned %>% 
  mutate(field_id = map_dbl(field_id,unlist)) %>% 
  left_join(your_ticket, by = c("field_id")) %>% 
  filter(str_starts(rule,"departure"))
your_assignment
## # A tibble: 6 x 4
##   rule                   n field_id input
##   <chr>              <int>    <dbl> <int>
## 1 departure time         8       19   193
## 2 departure station      9        1    61
## 3 departure platform    10       13   197
## 4 departure date        11       20   157
## 5 departure location    12       15   181
## 6 departure track       13        7    89
prod(your_assignment$input)
## [1] 5865723727753

Day Seventeen

Conway’s Game of Life was there in a previous day (day 11) - this one expanded into multiple dimensions. I wrote a brute force naive solution, went to bed, and gambled on it solving for when I woke up (which it did)! I then went back and trimmed it down to two minutes runtime, so that was pretty nice!

— Description —

The experimental energy source is based on cutting-edge technology: a set of Conway Cubes contained in a pocket dimension! When you hear it’s having problems, you can’t help but agree to take a look.

The pocket dimension contains an infinite 3-dimensional grid. At every integer 3-dimensional coordinate (x,y,z), there exists a single cube which is either active or inactive.

So essentially Conway’s game of life again…but in three dimensions?

— Data —

input_17 <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-17.txt")
input_17_e <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-17-example-1.txt")

— Cleaning —

Exploring a new part of R to me: arrays, which are vertically stacked matrices.

example_matrix <- tibble(x = input_17_e) %>%
  mutate(x = str_split(x, "")) %>%
  unnest_wider(x, names_sep = "_") %>%
  mutate_all(~ case_when(.x == "#" ~ 1, TRUE ~ 0)) %>%
  as.matrix()

example_empty <- matrix(
  data = rep(0, length(example_matrix)),
  nrow = nrow(example_matrix),
  ncol = ncol(example_matrix)
)

example_array <- c(example_empty, example_matrix, example_empty) %>%
  array(dim = c(nrow(example_matrix), ncol(example_matrix), 3))

input_matrix <- tibble(x = input_17) %>%
  mutate(x = str_split(x, "")) %>%
  unnest_wider(x, names_sep = "_") %>%
  mutate_all(~ case_when(.x == "#" ~ 1, TRUE ~ 0)) %>%
  as.matrix()

input_empty <- matrix(
  data = rep(0, length(input_matrix)), byrow = TRUE,
  nrow = nrow(input_matrix),
  ncol = ncol(input_matrix)
)

input_array <- c(input_empty, input_matrix, input_empty) %>%
  array(dim = c(nrow(input_matrix), ncol(input_matrix), 3))

Okay! So now we have the starting states of the example as example_array and the actual problem as input_array. We can access the dimensions of the arrays via

dim(example_array)
## [1] 3 3 3

and access a specific layer with array[row,column,layer].

example_array[1, 2, 2]
## [1] 1

— Problem 1 —

We can build out a list of indices with the dimensions, I think!

# array <- example_array

get_indices <- function(array) {
  dimensions <- dim(array)

  actual_indices <- crossing(
    x = seq_len(dimensions[[1]]),
    y = seq_len(dimensions[[2]]),
    z = seq_len(dimensions[[3]])
  ) %>%
    arrange(z, x, y) %>%
    mutate(
      value = pmap_dbl(list(x, y, z), ~ array[...]),
      x = x + 1,
      y = y + 1
    )

  indices <- crossing(
    x = seq_len(dimensions[[1]] + 2),
    y = seq_len(dimensions[[2]] + 2),
    z = seq_len(dimensions[[3]])
  ) %>%
    arrange(z, x, y) %>%
    left_join(actual_indices, by = c("x", "y", "z")) %>%
    mutate_all(replace_na, 0)

  return(indices)
}

example_indices <- get_indices(example_array)

Now to create a function to check the neighbouring indices and count nearby occupied cells.

# indices <- example_indices
# x <- 1
# y <- 2
# z <- 2

count_neighbours <- function(x, y, z, indices) {
  x_max <- max(indices$x)
  y_max <- max(indices$y)
  z_max <- max(indices$z)

  increments <- c(-1, 0, 1)

  neighbours <- crossing(
    x = increments + x,
    y = increments + y,
    z = increments + z
  ) %>%
    filter(
      !(.data$x == .env$x & .data$y == .env$y & .data$z == .env$z),
      between(.data$x, 1, x_max),
      between(.data$y, 1, y_max),
      between(.data$z, 1, z_max)
    ) %>%
    mutate(value = pmap_dbl(list(x, y, z), ~ indices$value[indices$x == ..1 & indices$y == ..2 & indices$z == ..3])) %>%
    pull(value) %>%
    sum()

  return(neighbours)
}

example_neighbours <- example_indices %>%
  mutate(neighbours = pmap_dbl(list(x, y, z), count_neighbours, .))

Now that we have the neighbours, we need to increment their values based on the rules.

# indices <- example_neighbours

apply_rules <- function(indices) {
  x <- indices %>%
    mutate(new_value = case_when(
      value == 1 & neighbours %in% c(2, 3) ~ 1,
      value == 1 ~ 0,
      value == 0 & neighbours == 3 ~ 1,
      TRUE ~ 0
    ))
  return(x)
}

example_count <- example_neighbours %>%
  apply_rules()

(I was stumped for a while here as to why my puzzle input did not match up to the example, but consulting no-spoilers-reddit seems that they’re dropping empty x/y dimensions which is quite annoying!)

Now to increment the array in every direction (but sticking with a list of indices for now, I find that easier to work with mentally)

# indices <- example_count
grow_indices <- function(indices) {
  new_x <- max(indices$x + 2) %>% seq_len()
  new_y <- max(indices$y + 2) %>% seq_len()
  new_z <- max(indices$z + 2) %>% seq_len()

  new_indices <- indices %>%
    transmute(
      x = x + 1,
      y = y + 1,
      z = z + 1,
      value = new_value
    )

  indices <- crossing(
    x = new_x,
    y = new_y,
    z = new_z
  ) %>%
    left_join(new_indices, by = c("x", "y", "z")) %>%
    mutate(value = replace_na(value, 0))

  return(indices)
}
# grow_indices(example_count)

Wrap it all into a caller function and for-loop.

# array <- example_array
# times <- 6

run_conwaycube <- function(array, times) {
  indices <- get_indices(array)

  for (i in seq_len(times)) {
    indices <- indices %>%
      mutate(neighbours = pmap_dbl(list(x, y, z), count_neighbours, .)) %>%
      apply_rules() %>%
      grow_indices()

    message(paste(i, Sys.time()))
  }

  return(sum(indices$value))
}

run_conwaycube(input_array,6)
1 2020-12-17 10:26:13
2 2020-12-17 10:26:16
3 2020-12-17 10:26:22
4 2020-12-17 10:26:33
5 2020-12-17 10:26:52
6 2020-12-17 10:27:23

280

— Problem 2 —

FOUR DIMENSIONS?! (brain explodes)

Actually, maybe I can just adjust my functions for a fourth dimension w

get_indices_4d <- function(array) {
  
  dimensions <- dim(array)
  
  actual_indices <- crossing(
    x = seq_len(dimensions[[1]]),
    y = seq_len(dimensions[[2]]),
    z = seq_len(dimensions[[3]])
  ) %>%
    arrange(z, x, y) %>%
    mutate(
      value = pmap_dbl(list(x, y, z), ~ array[...]),
      x = x + 1,
      y = y + 1,
      w = 2
    )
  
  indices <- crossing(
    x = seq_len(dimensions[[1]] + 2),
    y = seq_len(dimensions[[2]] + 2),
    z = seq_len(dimensions[[3]]),
    w = seq_len(dimensions[[3]])
  ) %>%
    arrange(z, x, y, w) %>%
    left_join(actual_indices, by = c("x", "y", "z", "w")) %>%
    mutate_all(replace_na, 0)
  
  return(indices)
}

count_neighbours_4d <- function(x, y, z, w, indices) {
  x_max <- max(indices$x)
  y_max <- max(indices$y)
  z_max <- max(indices$z)
  w_max <- max(indices$w)
  
  increments <- c(-1, 0, 1)
  
  neighbours <- crossing(
    x = increments + x,
    y = increments + y,
    z = increments + z,
    w = increments + w
  ) %>%
    filter(
      !(.data$x == .env$x & 
          .data$y == .env$y & 
          .data$z == .env$z & 
          .data$w == .env$w),
      between(.data$x, 1, x_max),
      between(.data$y, 1, y_max),
      between(.data$z, 1, z_max),
      between(.data$w, 1, w_max)
    ) %>%
    mutate(
      value = pmap_dbl(
        list(x, y, z, w), 
        ~ indices$value[indices$x == ..1 & 
                          indices$y == ..2 & 
                          indices$z == ..3 & 
                          indices$w == ..4])) %>%
    pull(value) %>%
    sum()
  
  return(neighbours)
}

# apply rules doesn't change since rules are the same

grow_indices_4d <- function(indices) {
  new_x <- max(indices$x + 2) %>% seq_len()
  new_y <- max(indices$y + 2) %>% seq_len()
  new_z <- max(indices$z + 2) %>% seq_len()
  new_w <- max(indices$w + 2) %>% seq_len()
  
  new_indices <- indices %>%
    transmute(
      x = x + 1,
      y = y + 1,
      z = z + 1,
      w = w + 1,
      value = new_value
    )
  
  indices <- crossing(
    x = new_x,
    y = new_y,
    z = new_z,
    w = new_w
  ) %>%
    left_join(new_indices, by = c("x", "y", "z", "w")) %>%
    mutate(value = replace_na(value, 0))
  
  return(indices)
}

run_conwaycube_4d <- function(array, times) {
  
  indices <- get_indices_4d(array)
  
  message(paste(Sys.time(), nrow(indices)))
  
  for (i in seq_len(times)) {
    indices <- indices %>%
      mutate(neighbours = pmap_dbl(list(x, y, z, w), count_neighbours_4d, .)) %>%
      apply_rules() %>%
      grow_indices_4d()
    message(paste(i, Sys.time(), nrow(indices)))
  }
  return(sum(indices$value))
}

run_conwaycube_4d(input_array, 6)
2020-12-17 02:01:36 900
1 2020-12-17 02:01:41 3600
2 2020-12-17 02:02:12 9604
3 2020-12-17 02:04:46 20736
4 2020-12-17 02:15:10 39204
5 2020-12-17 02:50:04 67600
6 2020-12-17 04:35:08 108900

[1] 1696

Admittedly, I plugged this in and went to sleep - but it was the correct answer!

— Iterating on Problem 2 for speed —

Problem 2 takes quite some time to run. Trying a few approaches to trimming it down:

Firstly, as Liam Y suggested in the R4DS Slack - arrange the neighbour function so that it’s only checking neighbours that have positive integer values:

count_neighbours_4d <- function(indices){

  filtered_indices <- indices %>%
    filter(value == 1) # This should reduce the amount of iteration needed!

  indices %>%
    mutate(neighbours = pmap_dbl(list(x,y,z,w),check_each_neighbour,filtered_indices))
}

check_each_neighbour <- function(x, y, z, w, indices){

  increments <- c(-1, 0, 1)

  n <- crossing(
    x = increments + x,
    y = increments + y,
    z = increments + z,
    w = increments + w
  ) %>%
    filter(
      !(.data$x == .env$x & 
          .data$y == .env$y & 
          .data$z == .env$z & 
          .data$w == .env$w)
    ) %>%
    mutate(
      value = pmap(list(.data$x,.data$y,.data$z,.data$w),
                   ~(indices$value[indices$x == ..1 & indices$y == ..2 & indices$z == ..3 & indices$w == ..4]))) %>%
    pull(value) %>%
    unlist() %>%
    sum(na.rm = TRUE)

  return(n)
}

run_conwaycube_4d <- function(array, times) {
  indices <- get_indices_4d(array)

  message(paste(Sys.time(), nrow(indices)))

  for (i in seq_len(times)) {
    indices <- indices %>%
      count_neighbours_4d() %>% 
      apply_rules() %>%
      grow_indices_4d()

    message(paste(i, Sys.time(), nrow(indices)))
  }

  return(sum(indices$value))
}

run_conwaycube_4d(input_array, 6)
2020-12-17 16:08:14 900
1 2020-12-17 16:08:18 3600
2 2020-12-17 16:08:38 9604
3 2020-12-17 16:09:29 20736
4 2020-12-17 16:11:39 39204
5 2020-12-17 16:15:26 67600
6 2020-12-17 16:25:28 108900

[1] 1696

Just doing that much shrunk the run-time from 2 hours 35 minutes to ~17 minutes! I can do better though, I think - in Day 11’s final approach, I arranged things into a matrix and approached it from there - I think I can definitely do the same here! (and also, add parallel processing because duh)

count_neighbours_4d <- function(indices){

  v <- indices %>% 
    arrange(w,z,y,x) %>% 
    pull(value)
  
  a <- array(v,dim = c(max(indices$x),
                       max(indices$y),
                       max(indices$z),
                       max(indices$w)))

  i <- indices %>%
    mutate(neighbours = future_pmap_dbl(.l = list(.data$x,.data$y,.data$z,.data$w),.f = check_each_neighbour,a = .env$a))

  return(i)
}

check_each_neighbour <- function(x, y, z, w, a){

  increments <- c(-1, 0, 1)

  # browser()
  
  n <- crossing(
    x = increments + x,
    y = increments + y,
    z = increments + z,
    w = increments + w
  ) %>%
    filter(
      !(.data$x == .env$x & 
          .data$y == .env$y & 
          .data$z == .env$z & 
          .data$w == .env$w),
      between(.data$x,1,dim(a)[[1]]),
      between(.data$y,1,dim(a)[[2]]),
      between(.data$z,1,dim(a)[[3]]),
      between(.data$w,1,dim(a)[[4]]),
    ) %>%
    mutate(
      value = pmap_dbl(
        list(.data$x,.data$y,.data$z,.data$w),
        ~a[..1,..2,..3,..4])) %>%
    pull(value) %>%
    unlist() %>%
    sum(na.rm = TRUE)

  return(n)
}

run_conwaycube_4d <- function(array, times) {
  indices <- get_indices_4d(array)

  message(paste(Sys.time(), nrow(indices)))

  for (i in seq_len(times)) {
    indices <- indices %>%
      count_neighbours_4d() %>% 
      apply_rules() %>%
      grow_indices_4d()

    message(paste(i, Sys.time(), nrow(indices)))
  }

  return(sum(indices$value))
}

run_conwaycube_4d(input_array, 6)
2020-12-17 18:39:43 900
1 2020-12-17 18:39:45 3600
2 2020-12-17 18:39:48 9604
3 2020-12-17 18:39:56 20736
4 2020-12-17 18:40:13 39204
5 2020-12-17 18:40:44 67600
6 2020-12-17 18:41:39 108900
[1] 1696

Shaving it down to two minutes runtime is extremely satisfying!

Day Eighteen

I went to bed thinking that it was a regex problem and that I’d need to essentially write my own parser - but I eventually thought of tricking the R parser to evaluate in the order I wanted it to, and that was much less painful!

— Description —

Unfortunately, it seems like this “math” follows different rules than you remember.

The homework (your puzzle input) consists of a series of expressions that consist of addition (+), multiplication (*), and parentheses ((…)). Just like normal math, parentheses indicate that the expression inside must be evaluated before it can be used by the surrounding expression. Addition still finds the sum of the numbers on both sides of the operator, and multiplication still finds the product.

However, the rules of operator precedence have changed. Rather than evaluating multiplication before addition, the operators have the same precedence, and are evaluated left-to-right regardless of the order in which they appear.

— Data —

input_18 <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-18.txt")

— Cleaning —

operations <- tibble(x = input_18)

— Problem 1 —

R doesn’t have editable math operator precedence (which is a good thing!), but we can trick the R parser into evaluating * at the same level as + by string-replacing * with - and then switching the definition of - to be equal to *.

The R parser will read the operator list and decide which ones to do, and it knows that “+” is equal in precedence to “-”. So it will evaluate them left to right, and it goes back to the new definition of “-” which is "*".

`-` <- `*`
  
p1 <- operations %>% 
  mutate(modified_x = str_replace_all(x,"\\*","\\-"),
         output = map_dbl(modified_x,~ eval(parse(text = .x))))
head(p1)
## # A tibble: 6 x 2
##   modified_x                                                              output
##   <chr>                                                                    <dbl>
## 1 9 - 8 + 2 + (4 - (2 - 2 + 9 - 2) - 9 - 3 - 8) + 8 - 5                   1.13e5
## 2 8 - (9 + 5 + 5 - 6 + 8 - 3) - 5 - 7 - 4 + 9                             4.10e5
## 3 (9 + (2 - 6 + 7 - 5)) - (7 + 7 - 5 + (6 + 2 + 6) - (7 - 8 - 8 + 9))~    7.98e6
## 4 ((8 + 3 - 6 - 2) - 9 + 3) + 5 + 6 - 3                                   3.61e3
## 5 6 - (9 + 6 - (7 + 4 + 2 + 5 + 6) - 7 + 3 - (5 - 8 - 6 + 6 - 7 - 8))~    1.67e9
## 6 (8 - 6 + 8) + 6 - 8 - (9 - (6 + 8 - 3 + 8) + (7 - 9 - 6 - 3) - 3 + ~    9.44e6
sum(p1$output)
## [1] 16332191652452

For extra credit, here’s the abstract syntax tree for the first operation as written normally:

lobstr::ast(expression(9 * 8 + 2 + (4 * (2 * 2 + 9 * 2) * 9 * 3 * 8) + 8 * 5))
## o-expression 
## \-o-`+` 
##   +-o-`+` 
##   | +-o-`+` 
##   | | +-o-`*` 
##   | | | +-9 
##   | | | \-8 
##   | | \-2 
##   | \-o-`(` 
##   |   \-o-`*` 
##   |     +-o-`*` 
##   |     | +-o-`*` 
##   |     | | +-o-`*` 
##   |     | | | +-4 
##   |     | | | \-o-`(` 
##   |     | | |   \-o-`+` 
##   |     | | |     +-o-`*` 
##   |     | | |     | +-2 
##   |     | | |     | \-2 
##   |     | | |     \-o-`*` 
##   |     | | |       +-9 
##   |     | | |       \-2 
##   |     | | \-9 
##   |     | \-3 
##   |     \-8 
##   \-o-`*` 
##     +-8 
##     \-5

and the revised version:

lobstr::ast(expression(9 - 8 + 2 + (4 - (2 - 2 + 9 - 2) - 9 - 3 - 8) + 8 - 5))
## o-expression 
## \-o-`-` 
##   +-o-`+` 
##   | +-o-`+` 
##   | | +-o-`+` 
##   | | | +-o-`-` 
##   | | | | +-9 
##   | | | | \-8 
##   | | | \-2 
##   | | \-o-`(` 
##   | |   \-o-`-` 
##   | |     +-o-`-` 
##   | |     | +-o-`-` 
##   | |     | | +-o-`-` 
##   | |     | | | +-4 
##   | |     | | | \-o-`(` 
##   | |     | | |   \-o-`-` 
##   | |     | | |     +-o-`+` 
##   | |     | | |     | +-o-`-` 
##   | |     | | |     | | +-2 
##   | |     | | |     | | \-2 
##   | |     | | |     | \-9 
##   | |     | | |     \-2 
##   | |     | | \-9 
##   | |     | \-3 
##   | |     \-8 
##   | \-8 
##   \-5

— Problem 2 —

Problem 2 is in the same vein but now just needs the + evaluated before the *, so we can do the same * to - swap and then now switch + to the * symbol, so that R thinks it is evaluated before the -.

`-` <- `*`
`*` <- `+`
  
p2 <- operations %>% 
  mutate(modified_x = str_replace_all(x,"\\*","\\-"),
         modified_x = str_replace_all(modified_x,"\\+","\\*"),
         output = map_dbl(modified_x,~ eval(parse(text = .x))))
head(p2)
## # A tibble: 6 x 2
##   modified_x                                                              output
##   <chr>                                                                    <dbl>
## 1 9 - 8 * 2 * (4 - (2 - 2 * 9 - 2) - 9 - 3 - 8) * 8 - 5                   1.71e6
## 2 8 - (9 * 5 * 5 - 6 * 8 - 3) - 5 - 7 - 4 * 9                             2.90e6
## 3 (9 * (2 - 6 * 7 - 5)) - (7 * 7 - 5 * (6 * 2 * 6) - (7 - 8 - 8 * 9))~    7.04e7
## 4 ((8 * 3 - 6 - 2) - 9 * 3) * 5 * 6 - 3                                   4.78e3
## 5 6 - (9 * 6 - (7 * 4 * 2 * 5 * 6) - 7 * 3 - (5 - 8 - 6 * 6 - 7 - 8))~    4.64e9
## 6 (8 - 6 * 8) * 6 - 8 - (9 - (6 * 8 - 3 * 8) * (7 - 9 - 6 - 3) - 3 * ~    4.81e8
sum(p2$output)
## [1] 351175492232654

The same “extra credit exercise”:

lobstr::ast(expression(9 * 8 + 2 + (4 * (2 * 2 + 9 * 2) * 9 * 3 * 8) + 8 * 5))
## o-expression 
## \-o-`+` 
##   +-o-`+` 
##   | +-o-`+` 
##   | | +-o-`*` 
##   | | | +-9 
##   | | | \-8 
##   | | \-2 
##   | \-o-`(` 
##   |   \-o-`*` 
##   |     +-o-`*` 
##   |     | +-o-`*` 
##   |     | | +-o-`*` 
##   |     | | | +-4 
##   |     | | | \-o-`(` 
##   |     | | |   \-o-`+` 
##   |     | | |     +-o-`*` 
##   |     | | |     | +-2 
##   |     | | |     | \-2 
##   |     | | |     \-o-`*` 
##   |     | | |       +-9 
##   |     | | |       \-2 
##   |     | | \-9 
##   |     | \-3 
##   |     \-8 
##   \-o-`*` 
##     +-8 
##     \-5

revised to:

lobstr::ast(9 - 8 * 2 * (4 - (2 - 2 * 9 - 2) - 9 - 3 - 8) * 8 - 5)
## o-`-` 
## +-o-`-` 
## | +-9 
## | \-o-`*` 
## |   +-o-`*` 
## |   | +-o-`*` 
## |   | | +-8 
## |   | | \-2 
## |   | \-o-`(` 
## |   |   \-o-`-` 
## |   |     +-o-`-` 
## |   |     | +-o-`-` 
## |   |     | | +-o-`-` 
## |   |     | | | +-4 
## |   |     | | | \-o-`(` 
## |   |     | | |   \-o-`-` 
## |   |     | | |     +-o-`-` 
## |   |     | | |     | +-2 
## |   |     | | |     | \-o-`*` 
## |   |     | | |     |   +-2 
## |   |     | | |     |   \-9 
## |   |     | | |     \-2 
## |   |     | | \-9 
## |   |     | \-3 
## |   |     \-8 
## |   \-8 
## \-5

Day Nineteen

This one was the regex problem that I feared in Day Eighteen’s problem. Looping over the rules and substituting them worked okay in the first part, but I spent far too long trying to learn recursive regex and eventually reduced the problem down to hardcoded recursion.

— Description —

They think their satellite has collected an image of a sea monster! Unfortunately, the connection to the satellite is having problems, and many of the messages sent back from the satellite have been corrupted.

They sent you a list of the rules valid messages should obey and a list of received messages they’ve collected so far (your puzzle input).

Your goal is to determine the number of messages that completely match rule 0.

— Data —

input_19 <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-19.txt")

input_19_e <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-19-e.txt")

input_19_e2 <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-19-e2.txt")

— Cleaning —

Seems nice to split the list of rules into its own tibble.

messages_e <- tibble(message = input_19_e) %>% 
  mutate(type = cumsum(message == "")) %>% 
  filter(type == 1,message !="") %>% 
  select(-type)

rules_e <- tibble(rule = input_19_e) %>% 
  mutate(type = cumsum(rule == "")) %>% 
  filter(type == 0) %>% 
  select(-type) %>% 
  separate(rule,into = c("rule_id","rule_desc"), sep = ": ")

messages <- tibble(message = input_19) %>% 
  mutate(type = cumsum(message == "")) %>% 
  filter(type == 1,message !="") %>% 
  select(-type)

rules <- tibble(rule = input_19) %>% 
  mutate(type = cumsum(rule == "")) %>% 
  filter(type == 0) %>% 
  select(-type) %>% 
  separate(rule,into = c("rule_id","rule_desc"), sep = ": ")

— Problem 1 —

Your goal is to determine the number of messages that completely match rule 0.

Okay, so writing a function that loops over the rules, taking only complete rules (i.e. rules without numbers) and string-replacing them into their rule_id. Also need to add padding so that the rule id doesn’t match individual digits, and need to add parentheses for rules that have an OR condition.

rule_recurse <- function(rules){
  
  rules <- rules %>% 
    mutate(rule_desc = if_else(str_detect(rule_desc,"a|b"), 
                               str_remove_all(rule_desc,'\\"'), 
                               rule_desc),
           rule_id = paste0(" ",rule_id," "),
           rule_desc = paste0(" ",rule_desc," "),
           rule_desc = if_else(str_detect(rule_desc,"\\|"),
                               paste0(" ( ",rule_desc," ) "),
                               rule_desc))
  
  while(any(str_detect(rules$rule_desc,"[0-9]"))){
    
    x <- rules %>% 
      filter(!str_detect(rule_desc,"[0-9]"))
    
    for(i in seq_along(x$rule_id)){
      rules$rule_desc <- str_replace_all(rules$rule_desc, x$rule_id[i], x$rule_desc[i])
    }
  }
  
  rules <- rules %>% 
    mutate_all(str_remove_all," ") %>% 
    mutate(rule_desc = paste0("^",rule_desc,"$"))
  
  return(rules)
}
 
rules_e1 <- rules_e %>% 
  rule_recurse() %>% 
  filter(rule_id == 0) %>% 
  pull(rule_desc)

messages_e1 <- messages_e %>% 
  mutate(match = str_detect(message,rules_e1))

p1_rules <- rules %>% 
  rule_recurse() %>% 
  filter(rule_id == 0) %>% 
  pull(rule_desc)

p1_messages <- messages %>% 
  mutate(match = str_detect(message,p1_rules))

sum(p1_messages$match)
## [1] 122

— Problem 2 —

Replace 8 and 11 with new rules that create looping - how to fix?

Approach: “Pray to the regex gods and hope they find you worthy”

Deconstructing the rules changes:

8 is 42 | 42 8 - so it starts as 42, and then when replaced with itself becomes 42 42, 42 42 42 etc - we can represent this as “one or more of” pretty easily: 42 + handles that condition.

11 is trickier: 42 31 | 42 11 31 means plugging 42 31 recursively into the middle of another set of 42 and 31. I spent a reading through regex recursion on this one, went to bed, continued trying regex recursion on it, until I eventually decided to hardcode 42 31 | 42 42 31 31 | 42 42 42 31 31 31 etc for like ten iterations of the loop. (I tried fifty, and got a literal stack overflow error!)

messages_e2 <- tibble(message = input_19_e2) %>% 
  mutate(type = cumsum(message == "")) %>% 
  filter(type == 1,message !="") %>% 
  select(-type)

rules_e2 <- tibble(rule = input_19_e2) %>% 
  mutate(type = cumsum(rule == "")) %>% 
  filter(type == 0) %>% 
  select(-type) %>% 
  separate(rule,into = c("rule_id","rule_desc"), sep = ": ")

rule_updater <- function(rules){
  rules %>% 
    mutate(
      rule_desc = case_when(
        rule_id == "8" ~ "42 +",
        rule_id == "11" ~ 
          paste(
            map_chr(1:10, ~rep_len(42,.x) %>% paste(collapse = " ")),
            map_chr(1:10, ~rep_len(31,.x) %>% paste(collapse = " ")),
            collapse = " | "),
        TRUE ~ rule_desc))
}

p2_rules_e <- rules_e2 %>% 
  rule_updater() %>% 
  rule_recurse() %>% 
  filter(rule_id == 0) %>% 
  pull(rule_desc)

messages_p2_e <- messages_e2 %>%
  mutate(match = str_detect(message,p2_rules_e))

sum(messages_p2_e$match)
## [1] 12
p2_rules <- rules %>% 
  rule_updater() %>% 
  rule_recurse() %>% 
  filter(rule_id == 0) %>% 
  pull(rule_desc)

p2_messages <- messages %>% 
  mutate(match = str_detect(message, p2_rules))

sum(p2_messages$match)
## [1] 287

Working through the example only sort of helped: I got the example to be 12 but the actual problem ended up failing for hours. It was a good filter for bad solutions though, because when the example was wrong I knew not to bother with the actual problem.

Day Twenty

Jigsaw puzzle solving turned out to be quite arduous. I came away from the first part quite confident (cracking the top 1000 solves for part 1!) but obviously had taken the shortcut for finding the corners and didn’t actually solve the puzzle tiles into a single matrix. Iterating over the rest of the puzzle took me the better part of the afternoon and evening.

I never felt entirely out of my depth, but it was definitely a slog for motivation.

— Description —

The camera array consists of many cameras; rather than produce a single square image, they produce many smaller square image tiles that need to be reassembled back into a single image.

Worse yet, the camera array appears to be malfunctioning: each image tile has been rotated and flipped to a random orientation. Your first task is to reassemble the original image by orienting the tiles so they fit together.

— Data —

input_20 <- read_lines("https://github.com/tanho63/advent_of_code/raw/master/2020/day-20.txt")

— Cleaning —

tiles <- tibble(tile = input_20) %>%
  mutate(id = if_else(str_starts(tile,"Tile"),tile,NA_character_),
         id = parse_number(id)) %>%  
  fill(id) %>% 
  filter(tile!="",str_detect(tile,"Tile ",negate = TRUE)) %>%
  mutate(tile = str_split(tile,"")) %>% 
  group_by(id) %>% 
  summarise(tile = list(unlist(tile))) %>% 
  mutate(tile = map(tile,~matrix(.x,nrow = 10, ncol = 10, byrow = TRUE)))

— Problem 1 —

Find corner tiles.

tile_edges <- tiles %>% 
  mutate(tile_edges = map(tile, 
                          ~list(
                            top = .x[1,], top_rev = rev(.x[1,]),
                            bottom = .x[10,], bottom_rev = rev(.x[10,]),
                            left = .x[,1], left_rev = rev(.x[,1]),
                            right = .x[,10], right_rev = rev(.x[,10])))) %>% 
  unnest_longer(tile_edges,indices_to = "border_position") %>% 
  transmute(id,border_position,tile_edges = map_chr(tile_edges,paste,collapse = "")) 

p1 <- tile_edges %>% 
  group_by(tile_edges) %>% 
  mutate(matches = n()-1) %>% 
  ungroup() %>% 
  group_by(id) %>% 
  summarise(sum_matches = sum(matches)/2) %>% 
  filter(sum_matches == 2)

p1
## # A tibble: 4 x 2
##      id sum_matches
##   <dbl>       <dbl>
## 1  1109           2
## 2  1693           2
## 3  2909           2
## 4  3371           2
prod(p1$id)
## [1] 18411576553343

— Problem 2 —

Assemble the picture and find the sea monster.

(Internal swearing as I only found the corners first and didn’t actually do the joining bit, so time to catch up)

matching_edges <- tile_edges %>% 
  group_by(tile_edges) %>% 
  mutate(matches = n()-1, 
         matching_tiles = list(id)) %>% 
  ungroup() %>% 
  filter(matches!=0) %>% 
  mutate(matching_tiles = map2_dbl(matching_tiles,id,~.x[.x!=.y])) %>%
  group_by(id) %>% 
  mutate(matches = sum(matches)/2) %>% 
  ungroup()

edges <- matching_edges %>% 
  filter(matches <= 3) %>% 
  distinct(id,matches,matching_tiles) %>% 
  filter(matching_tiles %in% .$id)

corners <- matching_edges %>% 
  filter(matches == 2)
id_matrix <- matrix(numeric(),nrow = 12, ncol = 12)

perimeter <- c(1109,1181)
perimeter_options <- edges %>% 
  filter(!matching_tiles %in% perimeter)

while(nrow(perimeter_options)>0){
 
  i <- length(perimeter)+1
  
  perimeter[i] <- perimeter_options %>% 
    filter(id == tail(perimeter,1)) %>% 
    pull(matching_tiles)
  
  perimeter_options <- perimeter_options %>% 
    filter(!matching_tiles %in% perimeter)
}

id_matrix[1,] <- perimeter[1:12]
id_matrix[,12] <- perimeter[12:23]
id_matrix[12,] <- rev(perimeter[23:34])
id_matrix[,1] <- c(1109,rev(perimeter[34:44]))

rm(perimeter_options,perimeter)

id_matrix
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
##  [1,] 1109 1181 2719 1373 1303 1637 3023 1447 1361  1019  1733  1693
##  [2,] 1487   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  1609
##  [3,] 3319   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  2861
##  [4,] 2423   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  1867
##  [5,] 2161   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  3229
##  [6,] 2999   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  3313
##  [7,] 1069   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  3677
##  [8,] 2371   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  3833
##  [9,] 3821   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  3779
## [10,] 1523   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  2819
## [11,] 3637   NA   NA   NA   NA   NA   NA   NA   NA    NA    NA  2917
## [12,] 3371 2543 2749 3301 2141 1061 1597 2459 1759  2633  2207  2909

YAY WE HAVE THE PERIMETER! (Still a mountain to climb, but hey.)

Filling in the middles by looking at the tile above and the tile to the left.

middles <- matching_edges %>% 
  filter(matches == 4) %>% 
  distinct(id,matching_tiles)

for(col in 2:11){
  for(row in 2:11){
    
    up <- id_matrix[row-1,col]
    left <- id_matrix[row,col-1]
    
    v <- middles %>% 
      filter(matching_tiles %in% c(up,left)) %>% 
      group_by(id) %>% 
      summarise(n = n()) %>% 
      filter(n == 2) %>% 
      pull(id)
    
    middles <- middles %>% filter(id!=v)
    
    id_matrix[row,col] <- v 
  }
}

rm(up, left, v)

id_matrix
##       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
##  [1,] 1109 1181 2719 1373 1303 1637 3023 1447 1361  1019  1733  1693
##  [2,] 1487 2441 3671 3221 1367 1097 3761 1601 1091  3253  1667  1609
##  [3,] 3319 3257 3863 2593 3089 3181 2273 2699 1429  1697  3691  2861
##  [4,] 2423 1213 1559 2969 2621 3739 1193 1823 2531  1489  2549  1867
##  [5,] 2161 3019 3881 2411 1619 2081 2617 2707 3527  3467  1439  3229
##  [6,] 2999 2843 2083 1789 2131 2521 3137 3673 2377  1123  1847  3313
##  [7,] 1069 2557 2777 1049 1993 1423 3931 1153 2663  1201  1129  3677
##  [8,] 2371 1553 3727 1249 1607 1741 2683 2039 1327  3011  1033  3833
##  [9,] 3821 3491 1783 3877 3413 3659 3517 1879 3583  3191  3533  3779
## [10,] 1523 3329 2677 2953 3463 1171 1627 2789 3203  3461  1103  2819
## [11,] 3637 1997 2221 2467 2287 2551 2897 1747 3967  1657  3299  2917
## [12,] 3371 2543 2749 3301 2141 1061 1597 2459 1759  2633  2207  2909

Okay! So we now have the location of each tile and now need to orient each tile correctly. Again starting from the top corner tile, now rotating and flipping the tile until it fits into the correct orientation.

Some helpers from Stack Overflow: https://stackoverflow.com/questions/16496210/rotate-a-matrix-in-r-by-90-degrees-clockwise

rotate_matrix <- function(x) t(x[nrow(x):1,])

flip_matrix <- function(x) x[nrow(x):1,]

First, fill in leftmost column of the matrix, aligning top of new tile with bottom of previous tile.

correct_tiles <- tiles %>% 
  filter(id == 1109)

for(i in 2:12){
  
  i_id <- id_matrix[i,1]
  up_id <- id_matrix[i-1,1]
  
  up_tile <- correct_tiles %>% 
    filter(id == up_id) %>% 
    pluck("tile", 1)
  
  up_bottom <- up_tile[10,] %>% paste(collapse = "")
  
  i_tile <- tiles %>% 
    filter(id == i_id) %>% 
    pluck("tile", 1)

  i_list <- tibble(tile = list(
    i_tile,
    i_tile %>% rotate_matrix(),
    i_tile %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix()
  )) %>% 
    mutate(match = map_lgl(tile,~.x[1,] %>% paste(collapse = "") == up_bottom)) %>% 
    filter(match)
  
  if(nrow(i_list)==0) stop()
  
  i_tile <- i_list$tile[[1]]
  
  correct_tiles <- tibble(id = i_id, tile = list(i_tile)) %>% 
    bind_rows(correct_tiles,.)
  
}

Okay, now orient the top row by accessing the right hand side:

for(i in 2:12){
  
  i_id <- id_matrix[1,i]
  left_id <- id_matrix[1,i-1]
  
  left_tile <- correct_tiles %>% 
    filter(id == left_id) %>% 
    pluck("tile", 1)
  
  left_right <- left_tile[,10] %>% paste(collapse = "")
  
  i_tile <- tiles %>% 
    filter(id == i_id) %>% 
    pluck("tile", 1)
  
  i_left <- i_tile[,1] %>% paste(collapse = "")
  
  i_list <- tibble(tile = list(
    i_tile,
    i_tile %>% rotate_matrix(),
    i_tile %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix()
  )) %>% 
    mutate(match = map_lgl(tile,~.x[,1] %>% paste(collapse = "") == left_right)) %>% 
    filter(match)
  
  if(nrow(i_list)==0) stop()
  
  i_tile <- i_list$tile[[1]]
  
  correct_tiles <- tibble(id = i_id, tile = list(i_tile)) %>% 
    bind_rows(correct_tiles,.)
  
}

correct_tiles

Now reapply the vertical orienter for each remaining column:

for(c in 2:12){ # c is column
  for(r in 2:12){ # r is row
    
    i_id <- id_matrix[r,c]
    up_id <- id_matrix[r-1,c]
    
    up_tile <- correct_tiles %>% 
      filter(id == up_id) %>% 
      pluck("tile", 1)
    
    up_bottom <- up_tile[10,] %>% paste(collapse = "")
    
  i_tile <- tiles %>% 
    filter(id == i_id) %>% 
    pluck("tile", 1)

  i_list <- tibble(tile = list(
    i_tile,
    i_tile %>% rotate_matrix(),
    i_tile %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix() %>% rotate_matrix(),
    i_tile %>% flip_matrix() %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix()
  )) %>% 
    mutate(match = map_lgl(tile,~.x[1,] %>% paste(collapse = "") == up_bottom)) %>% 
    filter(match)
  
  if(nrow(i_list)==0) stop()
  
  i_tile <- i_list$tile[[1]]
      
  correct_tiles <- tibble(id = i_id, tile = list(i_tile)) %>% 
    bind_rows(correct_tiles,.)
  }
}

Okay, so theoretically we now have a directory of correctly oriented tiles! Now to strip out the border rows from each tile:

borderless_tiles <- correct_tiles %>% 
  mutate(tile = map(tile,~.x[2:9,2:9]))

And then row-bind each column together, then bind each column together into the final matrix.

tile_matrix <- matrix(character(), nrow = 96)

for(c in 1:12){
  column_matrix <- matrix(character(), ncol = 8)
  
  for(r in 1:12){
    tile_id <- id_matrix[r,c]
    
    tile <- borderless_tiles %>% 
      filter(id == tile_id) %>% 
      pluck("tile",1)
    
    column_matrix <- rbind(column_matrix,tile)
  }
  
  tile_matrix <- cbind(tile_matrix,column_matrix)
}

Now to detect a seamonster! First, the monster:

monster <- tibble(x = c("                  # ", 
                        "#    ##    ##    ###",
                        " #  #  #  #  #  #   ")) %>% 
  mutate(x = str_split(x,""),
         row = row_number()) %>% 
  unnest_wider(x, names_sep = "") %>% 
  pivot_longer(cols = -row,names_to = "col") %>% 
  mutate(col = parse_number(col)) %>% 
  filter(value == "#")

Now, we need to loop over the tile matrix, looking at every 20-wide + 3-tall matrix to see if it’s a monster. We’ll need to do this for every iteration of the tile matrix (rotates and flips).

scan_tile_matrix_for_monsters <- function(tile_matrix,monster){
  
  monster_count <- 0
  
  for(c in 1:(ncol(tile_matrix)-19)){
    
    for(r in 1:(nrow(tile_matrix)-2)){
      
      x <- tile_matrix[r:(r+2),c:(c+19)]
      
      v <- map2_lgl(monster$row,monster$col, ~x[.x,.y]=="#") %>% all()
      
      if(v) monster_count <- monster_count + 1
    }
  }
  
  return(monster_count)
}

all_matrices <- list(
  tile_matrix,
  tile_matrix %>% rotate_matrix(),
  tile_matrix %>% rotate_matrix() %>% rotate_matrix(),
  tile_matrix %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix(),
  flip_matrix(tile_matrix),
  flip_matrix(tile_matrix) %>% rotate_matrix(),
  flip_matrix(tile_matrix) %>% rotate_matrix() %>% rotate_matrix(),
  flip_matrix(tile_matrix) %>% rotate_matrix() %>% rotate_matrix() %>% rotate_matrix()
  )

monster_count <- map_dbl(all_matrices,scan_tile_matrix_for_monsters,monster)

monster_count
## [1]  0  0 43  0  0  0  0  0
sum(tile_matrix == "#") - (max(monster_count) * nrow(monster))
## [1] 2002

Whew, that was a doozy!