Count teams contributing to European hubs over time

hub-team-tally.R

# Count teams contributing to European Forecast hub over time
library(gh)
library(purrr)
library(dplyr)
library(lubridate)
library(ggplot2)
library(ggrepel)

# Get model names / dates from github ---------------------------
model_names <- gh(paste0("/repos/covid19-forecast-hub-europe/covid19-",
                         "forecast-hub-europe/contents/data-processed/?recursive=1"))
model_names <- transpose(model_names)
model_names <- model_names[["name"]]
model_files <- map(model_names,
                   ~ gh(paste0("/repos/covid19-forecast-hub-europe/covid19-",
                               "forecast-hub-europe/contents/data-processed/",
                               .x, "?recursive=1")))
model_names_dates <- unlist(model_files)
model_names_dates <- model_names_dates[names(model_names_dates) == "name"]

models <- tibble("file" = model_names_dates) |>
  mutate(model = substr(file, 12, nchar(file)-4),
         date = floor_date(as.Date(substr(file, 1, 10)),
                           unit="week")) |>
  select(-file) |> 
  # exclude Hub own models
  filter(!grepl("EuroCOVIDhub", model))

#################
models <- models |> 
  mutate(model = as.factor(model)) |> 
  arrange(desc(date)) |> 
  mutate(model_freq = forcats::fct_inorder(model, ordered = TRUE))

models_latest <- models |> 
  group_by(model) |> 
  summarise(latest_date = max(date)) |> 
  mutate(most_recent = case_when(latest_date > Sys.Date() - 13 ~ "current",
                                 latest_date > Sys.Date() - 36 ~ "last month",
                                 latest_date > Sys.Date() - 120 ~ "older",
                                 TRUE ~ "older"),
         most_recent = factor(most_recent, c("current", "last month", "older"))) |> 
  select(-latest_date)

# Plot 
models |> 
  left_join(models_latest) |> 
  ggplot(aes(x = date, y = model_freq)) +
  geom_vline(aes(xintercept = floor_date(Sys.Date(), week_start = 2, unit = "week")), lty = 3) +
  geom_line(aes(col = most_recent)) +
  labs(x = NULL, y = NULL, col = "Last submission") +
  scale_colour_viridis_d(direction = 1) +
  scale_x_date(date_labels = "%b '%y", limits = c(as.Date("2021-03-08"), NA)) +
  theme_bw() +
  theme(legend.position = "bottom")

# ggsave("models.jpg", height = 9, width = 7)