13: Knights of the Dinner Table

library(mistlecode)

To install `mistlecode` yourself, run `devtools::install_github('guslipkin/mistlecode')`.

 Also loading:  cipheR data.table dplyr purrr slider stringr tidyverse glue

dt <- 
  fread("input.txt") |>
  select(V1, V3, V4, V11) |>
  `colnames<-`(c("origin", "direction", "units", "subject")) |>
  mutate(
    units = ifelse(direction == "lose", units * -1, units),
    subject = str_remove(subject, "\\.")
  ) |>
  select(-direction)

solve <- function(m) {
  m <- m + t(m)
  m2 <- 1 / scales::rescale(m)
  
  stops <-
    m2 |>
    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),
           end = ifelse(is.na(end), start[1], end))
  
  m |>
    data.frame() |>
    rownames_to_column() |>
    pivot_longer(!c("rowname")) |>
    filter(!is.na(value)) |>
    `colnames<-`(c("start", "end", "dist")) |>
    right_join(stops, by = c("start", "end")) |>
    pull(dist) |>
    sum()
}

As usual, this was moved into a function after part 1 because I reused it in part 2.

Part 1

Honestly, not a clue.

Okay. I’m back. It’s been a few weeks but I had a stroke of inspiration last night. I had started out trying a bunch of longer data and filtering, brute forcing, and anything else I could think of. BUT. Last night I realized this is just a circular traveling salesman problem. After a bit of fiddling with my solution from 2015-09 I was able to get it. Some key things were rescaling from 0-1 so that I don’t have both positive and negative numbers, then using the \(\frac{1}{x}\) trick to get longest distances instead of shortest.

m <- 
  dt |>
  dcast(origin ~ subject, value.var = "units", fill = 0) |>
  column_to_rownames("origin") |>
  as.matrix() |>
  `diag<-`(NA_integer_)

solve(m)

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

[1] 618

Part 2

I always knew my relationships had a happiness score of zero, but I didn’t need to be reminded of it :(.

m <-
  dt |>
  bind_rows(expand.grid(
    "origin" = "Gus",
    "units" = 0,
    "subject" = c("Gus", unique(dt$origin))
  )) |>
  dcast(origin ~ subject, value.var = "units", fill = 0) |>
  column_to_rownames("origin") |>
  as.matrix() |>
  `diag<-`(NA_integer_)

solve(m)

[1] 601