Looking back on Advent of Code now that I’ve cracked day 25 (on Christmas, no less), I can honestly say that I had a great time working through these. A vast majority of the problems I had some idea on how to solve (barring the one with Chinese Remainder Theorem) and when I got stuck I was able to deconstruct the solution from another language to understand their steps to solution and then implement it on my own in R.

As a data-oriented programmer I did think through the majority of the problems in tibbles, but one of the things I’ve learned is just getting way more comfortable with doing things in loops and vectors for programming efficency. Tibbles are great but not in terms of expensive/brute-force iterations - too many check steps and such.

I had never really written recursive functions before the few problems that needed it, but having these working examples really helped me think through the processes and I’m a lot more comfortable with recursion in R now.

Stats

Day       Time   Rank       Time   Rank
  25   08:29:27   8492   08:29:43   6475
  24   09:43:07   9326   11:43:30   8737
  23   09:54:26   9464   19:21:29   8927
  22   09:22:55  11636   22:33:08  12116
  21   19:54:17  11667   19:55:13  11415

I was losing too much sleep and stopped really spending time on these at the midnight hour. On the whole, these five were pretty decent to solve - I had to read up on linked lists and hex grid coordinates. Optimising recursion on Day 22 was definitely tricky, but I was really pleased when I cracked it.

Packages Used

Nothing too exotic in this round, my default packages here were more than enough.

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

Day Twenty One

Coming off of the nightmare of solving a jigsaw puzzle, this one turned out to be surprisingly…easy? Part two was definitely not much of an escalation.

— Data —

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

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

— Cleaning —

ingredient_list <- tibble(i = input_21) %>% 
  mutate(id = row_number()) %>% 
  separate(i, into = c("ingredient","allergen"), sep = " \\(contains ") %>% 
  separate_rows(ingredient,sep = " ") %>%
  mutate(allergen = str_remove(allergen,"\\)")) %>% 
  separate_rows(allergen,sep = ", ")

— Problem 1 —

Count non-allergens. Spent some time thinking about this one, but basically I’m grouping by allergen and getting the ingredients that occur the most for each allergen. If it’s a single ingredient, that’s the one (and then eliminates that ingredient from being the allergen from any of the others). Loop through this to create a table of allergens.

top_allergens <- ingredient_list %>% 
  group_by(ingredient,allergen) %>% 
  summarise(n = n())%>% 
  group_by(allergen) %>% 
  slice_max(n) %>% 
  mutate(nn = n()) %>%  
  arrange(nn,desc(n),allergen)

allergen_options <- top_allergens

allergen_df <- tibble()

while(nrow(allergen_options)>0) {
  
  x <- allergen_options %>% 
    filter(nn == 1) %>% 
    select(ingredient, allergen)

  allergen_df <- bind_rows(allergen_df, x)
  
  allergen_options <- allergen_options %>% 
    filter(!ingredient %in% allergen_df$ingredient, !allergen %in% allergen_df$allergen) %>% 
    group_by(allergen) %>% 
    mutate(nn = n())
}

non_allergens <- ingredient_list %>% 
  filter(!ingredient %in% allergen_df$ingredient) %>% 
  distinct(ingredient,id)

nrow(non_allergens)
## [1] 2428

— Problem 2 —

…is only to arrange the allergens in order? what?

allergen_df %>% 
  arrange(allergen) %>% 
  pull(ingredient) %>% 
  paste(collapse = ",")
## [1] "bjq,jznhvh,klplr,dtvhzt,sbzd,tlgjzx,ctmbr,kqms"

…that was … easy?!

Day Twenty Two

The War cardgame was easy enough to implement on first glance, but the recursion really hit me hard. There were some really elegant approaches I saw later that I’d maybe like to go back to (caching the subgame results or something).

— Data —

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

— Cleaning —

cards <- tibble(card = input_22) %>% 
  mutate(player = cumsum(str_detect(card,"Player"))) %>% 
  filter(card!="",!str_detect(card,"Player")) %>% 
  mutate(card = parse_number(card))

player_1 <- cards %>% 
  filter(player == 1) %>% 
  pull(card)

player_2 <- cards %>% 
  filter(player == 2) %>% 
  pull(card)
draw_card <- function(player){ head(player,1) }
remove_card <- function(player){ tail(player,-1) }

— Problem 1 —

Combat == “War” in my card game lexicon. Okay, looks straightforward enough:

g1_player1 <- player_1
g1_player2 <- player_2

while(all(length(g1_player1)>0,length(g1_player2)>0)){
  
  card_p1 <- draw_card(g1_player1)
  g1_player1 <- remove_card(g1_player1)
  
  card_p2 <- draw_card(g1_player2)
  g1_player2 <- remove_card(g1_player2)
  
  if(card_p1 > card_p2) g1_player1 <- c(g1_player1,card_p1,card_p2)
  
  if(card_p2 > card_p1) g1_player2 <- c(g1_player2,card_p2,card_p1)
  
}

g1_player1
##  [1] 45 13 16  8 38 27 35 24 44 18 34 17 39 21 10  5 33 12 31  3 15  1 50 49 26
## [26] 23 48 40 43 14 42 11 41 30 37 19 47 32 28 20 36 29 46  7  9  6 25  4 22  2
g1_player2
## [1] 0
(g1_player1 * 50:1) %>% sum()
## [1] 33421

— Problem 2 —

Recursive Combat? Le wot?

Rules:

  • Game instantly ends in a win if a previous round within this game has the same cards in the same order in the same players decks, award win to player 1
  • Begin round as usual by drawing the card.
  • If the number of cards remaining in the deck is more than the card they just drew, the winner of the round is determined by playing a new subgame of recursive combat.
  • If the number of cards remaining in the deck is less than the card they just drew (for either), the winner of the round is the player with the higher value card.

Lmao wtf okay…(insert meme)

i <- 0
recursive_combat <- function(player_1,player_2){

  i<<-i+1
  
  # Hold the early exit game state
  deck_states <- c()
  
  game_deck_player_1 <- player_1
  game_deck_player_2 <- player_2
  
  game_winner <- NULL
  
  loop <- 1
  
  while(loop != 0){
    
    # check deck states
    player_1_score <- sum(game_deck_player_1 * rev(seq_along(game_deck_player_1)))
    player_2_score <- sum(game_deck_player_2 * rev(seq_along(game_deck_player_2)))
    
    this_deck <- paste(player_1_score,player_2_score,sep = "-")
    
    if(this_deck %in% deck_states) {
      
      game_winner <- "player_one" 
      
      break
      
    } else {
      deck_states <- c(deck_states,this_deck)
    }
    
    # draw cards
    draw_player1 <- draw_card(game_deck_player_1)
    game_deck_player_1 <- remove_card(game_deck_player_1)
    
    draw_player2 <- draw_card(game_deck_player_2)
    game_deck_player_2 <- remove_card(game_deck_player_2)
    
    # Play recursive combat?
    
    if(length(game_deck_player_1)>=draw_player1 & length(game_deck_player_2)>=draw_player2) {
      
      round_winner <- recursive_combat(head(game_deck_player_1, draw_player1), 
                                       head(game_deck_player_2, draw_player2))$game_winner
      
    } else {
      round_winner <- ifelse(draw_player1 > draw_player2, "player_one", "player_two")
    }
    
    if(round_winner == "player_one") game_deck_player_1 <- c(game_deck_player_1,draw_player1,draw_player2)
    
    if(round_winner == "player_two") game_deck_player_2 <- c(game_deck_player_2,draw_player2,draw_player1)

    loop <- ifelse(length(game_deck_player_1) == 0 | length(game_deck_player_2) == 0,0,1)
    
  }
  
  if(is.null(game_winner)){
    game_winner <- ifelse(length(game_deck_player_1) > length(game_deck_player_2), "player_one", "player_two")
  }
  
  return(list(game_winner = game_winner,
              player_1 = game_deck_player_1, 
              player_2 = game_deck_player_2))
}

x <- recursive_combat(player_1,player_2)
## $game_winner
## [1] "player_one"
## 
## $player_1
##  [1] 18  5 47 38 49 21 34  1 45 33 32 23 39 36 27 16  2  6 43 40 42 24 10  9 35
## [26] 20 11  3 41 17 29 13 28 25 50 26 37  7 46 22 15  8 44 31 14 12 48 19 30  4
## 
## $player_2
## numeric(0)
sum(x$player_1 * rev(seq_along(x$player_1)))
## [1] 33651

Day Twenty Three

The first problem was no trouble, but the second problem definitely couldn’t be brute forced. Learning about linked lists and puzzling through the implementation solved part two much more efficiently.

— Data —

input_23 <- "496138527"

— Cleaning —

start_order <- str_split(input_23,"") %>% unlist %>% as.numeric

— Problem 1 —

p1 <- start_order

for(i in 1:100){
  
  current_cup <- p1[1]
  
  picked_up <- p1[2:4]
  
  other_cups <- tail(p1, -4)
  
  if(all(current_cup < other_cups)) {
    
    destination_cup <- max(other_cups)
    
  } else {
    
    destination_cup <- max(other_cups[(current_cup - other_cups) > 0])
    
  }
  d_loc <- which(other_cups == destination_cup)

  p1 <- c(
    head(other_cups,d_loc),
    picked_up,
    tail(other_cups,-d_loc),
    current_cup
    )
    
}

one_loc <- which(p1 == 1)

c(tail(p1,-one_loc),head(p1,one_loc-1)) %>% paste(collapse = "")
## [1] "69425837"

— Problem 2 —

Trying the naive solution first:

p2 <- c(start_order,seq.int(max(start_order),1000000))

for(i in 1:1000000){
  
  current_cup <- p2[1]
  
  picked_up <- p2[2:4]
  
  other_cups <- tail(p2, -4)
  
  if(all(current_cup < other_cups)) {
    
    destination_cup <- max(other_cups) 
    
  } else {
    
    destination_cup <- max(other_cups[(current_cup - other_cups) > 0])
    
  }
  d_loc <- which(other_cups == destination_cup)

  p2 <- c(
    head(other_cups,d_loc),
    picked_up,
    tail(other_cups,-d_loc),
    current_cup
    )
}

one_loc <- which(p2 == 1)

p2[one_loc + c(1,2)]

Killing it for being too slow.

Attempt 2: trying to store the location of the next variable for each variable (as suggested by other languages’ linked lists)

p2 <- c(start_order,seq.int(max(start_order)+1,1000000)) %>% as.integer()

next_cups <- c(p2[-1],p2[1])
cup_directory <- next_cups[order(p2)]

current_cup <- p2[1]

for (i in 1:10000000) {
  
  pickup_1 <- cup_directory[current_cup]
  pickup_2 <- cup_directory[pickup_1]
  pickup_3 <- cup_directory[pickup_2]
  
  destination_cup <- current_cup - 1:4
  
  destination_cup <- ifelse(
    destination_cup <=0, 
    max(cup_directory) + destination_cup, 
    destination_cup)
  
  destination_cup <- destination_cup[!destination_cup %in% c(pickup_1,pickup_2,pickup_3)]
  
  destination_cup <- head(destination_cup, 1)
  
  cup_directory[current_cup] <- cup_directory[pickup_3]
  # current now points to where third cup was pointing, removing three cups from loop
  
  cup_directory[pickup_3] <- cup_directory[destination_cup]
  # third now points to where destination cup was pointing
  
  cup_directory[destination_cup] <- pickup_1
  # destination cup now points at the first cup in the pickup
  
  current_cup <- cup_directory[current_cup]
  # move pointer to where the current cup is pointing
}

x1 <- cup_directory[1]
x2 <- cup_directory[x1]

prod(x1,x2)
## [1] 218882971435

About three minutes to run the loop, so not bad!

Day Twenty Four

Conway’s game of life made a lot of appearances in this AOC! This variant had hexagonal grids, which puzzled me for a while until I found a good resource on coordinate systems for hex grids.

— Data —

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

— Cleaning —

Hex grids coordinates c/o https://www.redblobgames.com/grids/hexagons/

directions_e <- tibble(i = input_24_e) %>% 
  mutate(i = str_extract_all(i,"se|sw|nw|ne|e|w"),
         id = row_number()) %>% 
  unnest_longer(i)

directions <- tibble(i = input_24) %>% 
  mutate(i = str_extract_all(i,"se|sw|nw|ne|e|w"),
         id = row_number()) %>% 
  unnest_longer(i)

hex_coordinates <- list(e = c(1,-1,0),
                        se = c(0,-1,1),
                        sw = c(-1,0,1),
                        w = c(-1,1,0),
                        nw = c(0,1,-1),
                        ne = c(1,0,-1)) %>% 
  enframe() %>% 
  unnest_wider(value,names_sep = "") %>% 
  rename(dx = value1, dy = value2, dz = value3)

— Problem 1 —

tile_locations <- directions %>% 
  left_join(hex_coordinates, by = c("i" = "name")) %>% 
  group_by(id) %>% 
  summarise(x = sum(dx),
            y = sum(dy),
            z = sum(dz)) %>% 
  group_by(x,y,z) %>% 
  summarise(n = n()) %>% 
  ungroup()

sum(tile_locations$n == 1)
## [1] 528

— Problem 2 — Another gd game of life problem?! FFS. Assuming that prev problem is day zero.

current_state <- tile_locations %>% 
  mutate(colour = ifelse(n == 1, "black", "white")) %>% 
  filter(colour == "black")

get_tile <- function(x,y,z,day){
  current_state$colour[current_state$x == x & current_state$y == y & current_state$z == z]
}

get_tile <- memoise::memoise(get_tile)

get_adjacent_tiles <- function(x,y,z, day){
  
  nx <- hex_coordinates$dx + x
  ny <- hex_coordinates$dy + y
  nz <- hex_coordinates$dz + z
  
  neighbours <- pmap(list(nx,ny,nz),get_tile,day)
  
  sum(unlist(neighbours) == "black", na.rm = TRUE)
  
}

for(day in 1:100){
  
  grid_range <- range(current_state[c('x','y','z')])
  
  search_grid <- seq.int(from = grid_range[1]-1, to = grid_range[2]+1) %>% 
    crossing(x = ., y = ., z = .) %>% 
    filter((x + y + z) == 0) %>%
    left_join(
      current_state %>% select(x,y,z,colour),
      by = c("x","y","z")
    ) %>% 
    mutate(colour = replace_na(colour,"white"),
           neighbours = pmap_dbl(list(x,y,z), get_adjacent_tiles, day),
           new_colour = case_when(colour == "black" & (neighbours == 0 | neighbours > 2) ~ "white",
                                  colour == "white" & (neighbours == 2) ~ "black",
                                  TRUE ~ colour))
  
  current_state <- search_grid %>% 
    select(x,y,z,colour = new_colour) %>% 
    filter(colour == "black")
  
  if(day %% 10 == 0) message(day)
  
}

nrow(current_state)
## [1] 4200

Day Twenty Five

This one took me an embarrassingly long time to read and understand, but once I finally groked it the programming itself was pretty straightforward. Part two was simply “make sure all the other problems are done” and that was a super nice little reward!

— Data —

input_25 <- c(2069194,16426071)

— Problem 1 —

find_loops <- function(input){
  
  goal_keys <- numeric(2)
  v <- 1
  i <- 0
  
  while(any(goal_keys %in% 0)){
   i <- i+1
   v <- (v * 7) %% 20201227
   
   if(v == input[1]) goal_keys[1] <- i
   if(v == input[2]) goal_keys[2] <- i
  }
  
  return(goal_keys)
}

loop_sizes <- find_loops(input_25)

encrypt_key <- function(public_key,loop_size){
  
  v <- 1
  
  for(i in seq_len(loop_size)) v <- (v * public_key) %% 20201227
  
  v
}

encrypt_key(input_25[1],loop_sizes[2])
## [1] 11576351