day23_pt1_v2.R

library(igraph)

# Example input, if needed
# day23 <- readLines("./puzzle_input/input_day23_exp.txt")

day23 <- readLines("./puzzle_input/input_day23.txt")

day23 <- do.call(rbind, strsplit(day23, ""))

## PART 1 ----------------------------------------------------------------------

start <- Sys.time()

start_tile <- nrow(day23) * (which(day23[1, ] == ".") - 1) + 1
end_tile <- nrow(day23) * (which(day23[nrow(day23), ] == ".") - 1) + nrow(day23)

# Find all vertices, i.e. all ^, v, > and < tiles, and all . tiles where more 
# than two corner tiles (or more) are .
slopes <- which(day23 %in% c("v", "^", "<", ">"))
ground <- which(day23 == ".")
is_node <- rep(FALSE, length(ground))

for (i in seq_along(ground)) {
  
  # If up AND down or left AND right are #, it's not a node
  not_a_node <- 
    (day23[ground[i] + 1] == "#" & day23[ground[i] - 1] == "#") |
    (day23[ground[i] + nrow(day23)] == "#" & day23[ground[i] - nrow(day23)] == "#")
  
  is_node[i] <- !not_a_node
  
}

ground <- ground[is_node]

is_critical <- rep(FALSE, length(ground))

for (i in seq_along(ground)) {
  
  is_critical[i] <- 
    sum(
      day23[
        c(
          ground[i] + 1, 
          ground[i] - 1, 
          ground[i] + nrow(day23), 
          ground[i] - nrow(day23)
        )
      ] == "#"
    ) < 2
  
}

# VERY cumbersome way to create a network from the matrix, lol

vertices <- c(start_tile, slopes, ground, end_tile)

# If it's a slope or a junction, it's a critical node (can't be deleted later).

vertices_coordinates <- 
  data.frame(
    x = ifelse(vertices %% nrow(day23) == 0, nrow(day23), vertices %% nrow(day23)),
    y = ceiling(vertices / nrow(day23)),
    is_critical = c(TRUE, rep(TRUE, length(slopes)), is_critical, TRUE),
    directional = 
      c(
        FALSE, rep(TRUE, length(slopes)), rep(FALSE, length(is_critical)), FALSE
      )
  )

vertices_coordinates <- 
  vertices_coordinates[order(vertices_coordinates$x, vertices_coordinates$y), ]

rownames(vertices_coordinates) <- NULL

nw_info <- data.frame(from = c(), to = c(), weight = c(), directional = c())

for (i in 1:nrow(vertices_coordinates)) {
  
  # Get adjacent node to the right or down (left and up should be redundant),
  # i.e. the nearest nodes right/down. Determine whether there's a connection 
  # and how long the edge is.
  temp_tile <- day23[vertices_coordinates$x[i], vertices_coordinates$y[i]]
  
  right <- 
    vertices_coordinates[
      vertices_coordinates$x == vertices_coordinates$x[i] &
        vertices_coordinates$y > vertices_coordinates$y[i],
    ]
  
  down <- 
    vertices_coordinates[
      vertices_coordinates$y == vertices_coordinates$y[i] &
        vertices_coordinates$x > vertices_coordinates$x[i], 
    ]
  
  if (temp_tile %in% c(".", ">")) {
    
    if (nrow(right) != 0) {
      
      clear_path <- 
        all(
          day23[vertices_coordinates$x[i], vertices_coordinates$y[i]:right$y[1]] != "#"
        )
      
      if (clear_path) {
        
        if (day23[right$x[1], right$y[1]] == "<") {
          
          nw_info <- 
            rbind.data.frame(
              nw_info,
              data.frame(
                from = paste(right[1, 1:2], collapse = "-"), 
                to = paste(vertices_coordinates[i, 1:2], collapse = "-"), 
                weight = right$y[1] - vertices_coordinates$y[i]
              )
            )
          
        } else {
          
          nw_info <- 
            rbind.data.frame(
              nw_info,
              data.frame(
                from = paste(vertices_coordinates[i, 1:2], collapse = "-"), 
                to = paste(right[1, 1:2], collapse = "-"), 
                weight = right$y[1] - vertices_coordinates$y[i],
                directional = ifelse(temp_tile == ">", TRUE, FALSE)
              )
            ) 
          
        }
        
      }
      
    }
    
  }
  
  if (temp_tile %in% c(".", "v")) {
    
    if (nrow(down) != 0) {
      
      clear_path <- 
        all(
          day23[vertices_coordinates$x[i]:down$x[1], vertices_coordinates$y[i]] != "#"
        )
      
      if (clear_path) {
        
        if (day23[down$x[1], down$y[1]] == "^") {
          
          nw_info <- 
            rbind.data.frame(
              nw_info,
              data.frame(
                from = paste(down[1, 1:2], collapse = "-"), 
                to = paste(vertices_coordinates[i, 1:2], collapse = "-"), 
                weight = down$x[1] - vertices_coordinates$x[i],
                directional = TRUE
              )
            )
          
        } else {
          
          nw_info <- 
            rbind.data.frame(
              nw_info,
              data.frame(
                from = paste(vertices_coordinates[i, 1:2], collapse = "-"), 
                to = paste(down[1, 1:2], collapse = "-"), 
                weight = down$x[1] - vertices_coordinates$x[i],
                directional = ifelse(temp_tile == "v", TRUE, FALSE)
              )
            ) 
          
        }
        
      }
      
    }
    
  }
  
}

# Repeat non-directional nodes on other direction.
nw_info <- 
  rbind.data.frame(
    nw_info,
    data.frame(
      from = nw_info$to[!nw_info$directional],
      to = nw_info$from[!nw_info$directional],
      weight = nw_info$weight[!nw_info$directional],
      directional = FALSE
    )
  )

# Delete non-critical nodes
vertices_coordinates$id <- 
  apply(
    vertices_coordinates[, 1:2], 
    1, 
    function(x) paste(x, collapse = "-")
  )

critical_vertices <- 
  nw_info[
    nw_info$from %in% vertices_coordinates$id[vertices_coordinates$is_critical], 
  ]

rownames(critical_vertices) <- NULL

new_vertices <- data.frame(from = c(), to = c(), weight = c())

for (i in 1:nrow(critical_vertices)) {
  
  temp_from <- critical_vertices$from[i]
  temp_to <- critical_vertices$to[i]
  weight_counter <- critical_vertices$weight[i]
  
  # Find next critical node and delete all in between
  while (!temp_to %in% critical_vertices$from) {
    
    previous <- temp_to
    
    temp_weight <- 
      nw_info$weight[
        nw_info$from == temp_to & nw_info$to != temp_from
      ]
    
    temp_to <- 
      nw_info$to[
        nw_info$from == temp_to & nw_info$to != temp_from
      ]
    
    if (length(temp_to) == 0) break
    
    temp_from <- previous
    
    weight_counter <- weight_counter + temp_weight
    
  }
  
  if (length(temp_to) == 0) next
  
  new_vertices <- 
    rbind.data.frame(
      new_vertices,
      data.frame(
        from = critical_vertices$from[i],
        to = temp_to,
        weight = weight_counter
      )
    )
  
}

nw <- graph_from_edgelist(as.matrix(new_vertices[ , 1:2]), directed = TRUE)

E(nw)$weight <- new_vertices$weight

all_paths <- 
  all_simple_paths(
    nw,
    paste0(vertices_coordinates[1, 1:2], collapse = "-"), 
    paste0(vertices_coordinates[nrow(vertices_coordinates), 1:2], collapse = "-")
  )

# It seems like I can't simply get the weight of a path?!

path_weights <- vector("numeric", length(all_paths))

for (i in seq_along(all_paths)) {
  
  temp_weight <- 0
  
  for (j in 1:(length(all_paths[[i]]) - 1)) {
    
    x <- names(all_paths[[i]][j])
    y <- names(all_paths[[i]][j + 1])
    temp_weight <-  temp_weight +
      new_vertices$weight[new_vertices$from == x & new_vertices$to == y]
    
  }
  
  path_weights[i] <- temp_weight
  
}

max(path_weights)
# 2106

Sys.time() - start