filter_df <- function(data, filter_list) {
  if (!is.list(filter_list) || is.null(filter_list) || length(filter_list) == 0) {
    return(data)
  }
  data <- data.table::copy(data)
  # filter as specified by the user
  for (expr in filter_list) {
    data <- data[eval(parse(text = expr)), ]
  }
  return(data)
}
df <- filter_df(data, filter_list)

quantiles <- round(c(0.01, 0.025, seq(0.05, 0.95, by = 0.05), 0.975, 0.99), 3)

df <- df %>%
  # Check all quantiles per target/location
  group_by(location, target_variable, target_end_date, model) %>%
  mutate(all_quantiles_present =
           (length(setdiff(quantiles, quantile)) == 0)) %>%
  ungroup() %>%
  filter(all_quantiles_present == TRUE) %>%
  select(-all_quantiles_present)

## if more than 1 location exists, filter to have at least half of them
if (length(unique(df$location)) > 1) {
  df <- df %>%
    group_by(model) %>%
    mutate(n = length(unique(location))) %>%
    ungroup() %>%
    mutate(nall = length(unique(location))) %>%
    filter(n >= nall / 2) %>%
    select(-n, -nall)
 }

table <- eval_forecasts(df, summarise_by = summarise_by, 
                        compute_relative_skill = TRUE)

if (nrow(table) == 0) {

} else {
  setcolorder(table, c("model", "relative_skill"))

  htmltools::tagList(
    table %>%
      arrange(relative_skill) %>%
      dplyr::select(-scaled_rel_skill) %>%
      mutate_if(is.numeric, round, 2) %>%
      dplyr::rename(wis = interval_score,
                    underpred = underprediction,
                    overpred = overprediction,
                    cvrage_dev = coverage_deviation,
                    rel_skill = relative_skill) %>%
      DT::datatable(extensions = c('FixedColumns', 'Buttons'),
                    width = "100%",
                    options = list(
                      paging = FALSE,
                      info = FALSE,
                      buttons = c('csv', 'excel'),
                      dom = 'Bfrtip',
                      scrollX = TRUE,
                      fixedColumns = TRUE
                    ), 
                    class = 'white-space: nowrap')
  )
}


epiforecasts/europe-covid-forecast documentation built on Jan. 15, 2025, 8:57 p.m.