johannes_model_performance.r

library("readr")
library("dplyr")
library("ggplot2")

highlight_models <- c(
  "EuroCOVIDhub-ensemble", "KITmetricslab-bivar_branching",
  "EuroCOVIDhub-baseline"
)

model_scores <- read_csv(paste0(
  "https://github.com/covid19-forecast-hub-europe/covid19-forecast-hub-europe/",
  "raw/main/evaluation/scores.csv"
), show_col_types = FALSE)

## limit to targets, countries, dates etc. that has all the highlight models
selected_scores <- model_scores |>
  mutate(flag = if_else(model %in% highlight_models, 1L, 0L)) |>
  group_by(target_variable, forecast_date, target_end_date, horizon,
           location, location_name) |>
  mutate(n = sum(flag)) |>
  filter(n == length(highlight_models)) |>
  select(-n) |>
  mutate(
    highlight_model =
      if_else(model %in% highlight_models, model, NA_character_),
    horizon = paste0(horizon, " week", if_else(horizon == 1, "", "s"))
  )


ggplot(selected_scores, aes(
  x = forecast_date, y = wis, group = model, colour = highlight_model,
  alpha = factor(flag))
) +
  geom_line(lwd = 1.5) +
  scale_colour_brewer("", palette = "Set1", na.value = "grey") +
  facet_wrap(~ horizon, scales = "free_y") +
  theme_bw() +
  xlab("Date of forecast") +
  theme(legend.position = "bottom") +
  scale_alpha_manual(values = c(0.3, 1), guide = "none") +
  ylab("WIS")