09: All in a Single Night

library(mistlecode)
dt <- 
  fread("input.txt") |>
  `colnames<-`(c("start", "to", "end", "eq", "dist")) |>
  select(start, end, dist) |>
  arrange(start, end)
stops <- 
  unique(c(dt$start, dt$end)) |>
  sort()

Oh no! It’s the traveling salesman!

get_stops <- function(m) {
  m |>
    TSP::as.TSP() |>
    TSP::insert_dummy(label = "dummy") |>
    TSP::solve_TSP(method = "nn", control = list(rep = 1000)) |>
    TSP::cut_tour('dummy') |>
    names() |>
    data.frame() |>
    `colnames<-`(c("start")) |>
    mutate("end" = lead(start)) |>
    filter(!is.na(end))
}

get_dist <- function(m, stops) {
  m |>
    data.frame() |>
    rownames_to_column() |>
    pivot_longer(!c("rowname")) |>
    `colnames<-`(c("start", "end", "dist")) |>
    right_join(stops, by = c("start", "end")) |>
    pull(dist) |>
    sum()
}

Part 1

I figured with R the way it is, there had to be a package that can solve it. Sure enough, TSP exists. Creating the symmetric matrix was a bit of a pain, but then I was getting solutions for the test input but not the real input. Ugh. I slept on the problem then tried replacing the diagonal with NA, rather than zeroes. That seemed to do the trick.

m <-
  expand.grid(stops, stops) |>
  data.table() |>
  `colnames<-`(c("start", "end")) |>
  left_join(dt, by = c("start", "end")) |>
  mutate(dist = ifelse(start == end, NA_integer_, dist)) |>
  dcast(start ~ end, value.var = "dist") |>
  data.frame() |>
  `rownames<-`(stops) |>
  select(-start) |>
  as.matrix()

m <-
  map2_dbl(m, t(m), \(x, y) {
    if(is.na(x) & !is.na(y)) return(y) else return(x)
  }) |>
  matrix(length(stops), length(stops)) |>
  `colnames<-`(stops) |>
  `rownames<-`(stops) |>
  as.matrix() 

stops <- get_stops(m)

Warning: executing %dopar% sequentially: no parallel backend registered

get_dist(m, stops)

[1] 251

Part 2

Oh boy. I think I have an easy solution for this! If I can re-scale the values so that the smallest numbers are biggest and the biggest numbers are smallest, I can just re-run to get the cities in order, then use the original distances. A quick apply with \(\frac{1}{x}\) and I’m on my way. Just need to throw everything into functions and there we go!

stops <-
  m |>
  apply(c(1, 2), \(x) 1 / x) |>
  get_stops()
get_dist(m, stops)

[1] 898