test-hub-validations

test-hub-validations.R

# test forecast file

library(dplyr)
library(tibble)
library(readr)
library(purrr)
library(here)

# `tests` contains 9 tibbles each to test one element of validation
# Each tibble is a forecast with one valid row (location A) and one invalid row (location B)

tests <- list(
  # location - should be one of hub set values
  location = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                     "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "point", NA, 9999,
                     "BX", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "point", NA, 9999),

  # forecast date - any day between wednesday to saturday shifts ahead 1 week to next target date
  forecast_weds_sat = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                              "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.1, 9999,
                              "BE", "2021-11-25", "2021-12-04", "2 wk ahead inc case", "quantile", 0.1, 9999), # should be 1 wk ahead for forecast date Weds-Sat

  # target end date - should not be too close to forecast date
  too_close = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                      "AT", "2021-11-22", "2021-11-27", "1 wk ahead inc case", "quantile", 0.2, 9999,
                      "BE", "2021-11-25", "2021-11-27", "1 wk ahead inc case", "quantile", 0.2, 9999), # 1 wk ahead target date would be 2021-12-04

  # target end date - should be a saturday
  target_sat = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                       "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.3, 9999,
                       "BE", "2021-11-22", "2021-12-05", "2 wk ahead inc case", "quantile", 0.3, 9999), # should be 2021-12-04

  # target - variable one of hub set values
  variable = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                     "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.4, 9999,
                     "BE", "2021-11-22", "2021-12-04", "2 wk ahead inc icu", "quantile", 0.4, 9999), # should be case/death/hosp

  # target - wk ahead horizon matches difference between forecast date and target date
  horizon = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                    "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.5, 9999,
                    "BE", "2021-11-22", "2021-12-11", "2 wk ahead inc case", "quantile", 0.5, 9999), # should be 3wk ahead

  # type - either quantile or point
  type = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                 "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.6, 9999,
                 "BE", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "point", 0.6, 9999), # should be quantile

  # quantile - one of set of hub set values
  quantile = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                     "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.7, 9999,
                     "BE", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.00001, 9999), # should be in range

  # value - should not exceed country population
  value = tribble(~location, ~forecast_date, ~target_end_date, ~target, ~type, ~quantile, ~value,
                  "AT", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.8, 9999,
                  "BE", "2021-11-22", "2021-12-04", "2 wk ahead inc case", "quantile", 0.8, 1e+15) # should not exceed pop in hub locations file
)

# Write to csv
#
# team <- "test"
# forecast_date <- "2021-11-22"
#
# map2(.x = tests, .y = names(tests),
#      ~ write_csv(.x, file = here("test-files",
#                                  paste0(forecast_date, "-",
#                                         team, "-", .y, ".csv"))))

# Test --------------------------------------------------------------------
# validate tibbles against the forecast hub schema: all results should be FALSE
forecast_schema <- "https://raw.githubusercontent.com/epiforecasts/covid19-forecast-hub-europe/main/data-processed/schema-forecast.yml"
schema_json <- toJSON(read_yaml(forecast_schema), auto_unbox = TRUE)

validate <- map(tests,
                ~ json_validate(toJSON(.x, dataframe = "columns", na = "null"),
                                schema_json,
                                engine = "ajv",verbose = TRUE, greedy = TRUE))