aoc_2024/day_20_quick.R at main · bcrossman/aoc_2024 · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
library(tidyverse)
library(igraph)

# Prep

input <- (readLines("inputs/input20.txt"))

create_grid <- function(df, add_border = FALSE) {

  grid <- df %>%
    rowid_to_column() %>%
    separate_rows(value, sep="", convert = TRUE) %>%
    drop_na(value) %>%
    filter(value != "") %>%
    mutate(rowid = rowid) %>%
    group_by(rowid) %>%
    mutate(colid = row_number()) %>%
    ungroup() %>%
    mutate(key = paste(colid, rowid, sep=", ")) %>%
    select(value, rowid, colid, key)

  if (add_border) {
    max_row <- max(grid$rowid)
    max_col <- max(grid$colid)

    # Add borders
    top_border <- tibble(value = "@", rowid = 0, colid = 1:(max_col + 2))
    bottom_border <- tibble(value = "@", rowid = max_row + 1, colid = 1:(max_col + 2))
    left_border <- tibble(value = "@", rowid = 1:max_row, colid = 0)
    right_border <- tibble(value = "@", rowid = 1:max_row, colid = max_col + 1)

    grid <- bind_rows(grid,
                      top_border,
                      bottom_border,
                      left_border,
                      right_border) %>%
      arrange(rowid, colid) %>%
      mutate(key = paste(colid, rowid, sep=", "))
  }

  return(grid)
}

data <- create_grid(as_tibble(input), add_border = FALSE) %>% rename(map = value)

create_edge_points <- function(data) {

  edge_points <- data %>%
    left_join(data %>% mutate(rowid = rowid-1),
              by = c("rowid","colid"),
              suffix = c("", "_down")) %>%
    left_join(data %>% mutate(rowid = rowid+1),
              by = c("rowid","colid"),
              suffix = c("", "_up")) %>%
    left_join(data %>% mutate(colid = colid+1),
              by = c("rowid","colid"),
              suffix = c("", "_left")) %>%
    left_join(data %>% mutate(colid = colid-1),
              by = c("rowid","colid"),
              suffix = c("", "_right")) %>%
    rename(key_start = key,
           map_start = map) %>%
    pivot_longer(cols = -c(rowid, colid),
                 names_to = c(".value", "direction"),
                 names_sep = "_") %>%
    filter(direction != "start") %>%
    rename(end = key,
           map_end = map) %>%
    mutate(start = paste(colid, rowid, sep=", ")) %>%
    left_join(data %>% select(key, map), by = c("start" = "key")) %>%
    select(start, end, map, map_end, direction) %>%
    drop_na(map_end) %>%
    drop_na(map)

  return(edge_points)
}

edge_points <- create_edge_points(data)

## Shortest no cheats
edge_list <-
  edge_points %>%
  filter(map != "#",
         map_end != "#") %>%
  select(start, end, map, direction)

g <- graph_from_data_frame(edge_list, directed = TRUE)

beg <- data %>% filter(map == "S") %>% pull(key)
end <- data %>% filter(map == "E") %>% pull(key)
sp <- shortest_paths(g, from = beg, to = end)
# no_cheat_time <- length(sp$vpath[[1]])-1
no_cheat_path <- sp$vpath[[1]]
path_names <- names(no_cheat_path)
path_points <- data %>% filter(key %in% path_names)

teleport_time_saver <- function(distance_max, time_saved_min) {
  valid_teleports <- path_points %>%
    select(-map) %>%
    tidyr::crossing(
      path_points %>%
        select(rowid_2 = rowid, colid_2 = colid, key_2 = key)
    ) %>%
    mutate(
      distance = abs(rowid_2 - rowid) + abs(colid_2 - colid),
      track_spot_1 = match(key, path_names),
      track_spot_2 = match(key_2, path_names),
      orig_distance = track_spot_2 - track_spot_1,
      time_saved = orig_distance - distance
    ) %>%
    filter(distance <= distance_max, time_saved >= time_saved_min) %>%
    nrow()

  return(valid_teleports)
}


##Part I
teleport_time_saver(2, 100)


##Part II
teleport_time_saver(20, 100)