Skip to content

Commit

Permalink
update report file
Browse files Browse the repository at this point in the history
  • Loading branch information
@nikosbosse
nikosbosse committed Feb 3, 2021
1 parent 7d2b3c4 commit 49603c9
Showing 1 changed file with 40 additions and 80 deletions.
120 changes: 40 additions & 80 deletions evaluation/report.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,90 +6,54 @@ library(readr)
library(scoringutils)
library(data.table)

# read in the EpiExpert ensemble forecast and EpiNow2 models
folders <- list.files(here::here("submissions", "human-forecasts"))
files <- purrr::map(folders,
.f = function(folder_name) {
files <- list.files(here::here("submissions", "human-forecasts", folder_name))
paste(here::here("submissions", "human-forecasts", folder_name, files))
}) %>%
unlist()
epiexpert_forecasts <- purrr::map_dfr(files, readr::read_csv) %>%
dplyr::mutate(board_name = "EpiExpert-ensemble",
submission_date = forecast_date,
horizon = as.numeric(gsub("([0-9]+).*$", "\\1", target))) %>%
dplyr::filter(grepl("inc", target),
type == "quantile")

data.table::fwrite(epiexpert_forecasts,
here::here("human-forecasts", "processed-forecast-data", "all-epiexpert-forecasts.csv"))


# helper function to read in all past submissions from a model, bind them together
# to one file and copy them into the crowd forecast app folder
# having them in one place allows to easily include other models in the
# crowd forecast report. Could in principle also do without copying
load_and_copy_forecasts <- function(root_dir,
out_file_path,
new_board_name) {
folders <- list.files(root_dir)
files <- purrr::map(folders,
.f = function(folder_name) {
files <- list.files(here::here(root_dir, folder_name))
paste(here::here(root_dir, folder_name, files))
}) %>%
unlist()

forecasts <- purrr::map_dfr(files, readr::read_csv) %>%
dplyr::mutate(board_name = new_board_name,
submission_date = forecast_date,
horizon = as.numeric(gsub("([0-9]+).*$", "\\1", target))) %>%
dplyr::filter(grepl("inc", target),
type == "quantile")

data.table::fwrite(forecasts, out_file_path)
}

# read in the EpiExpert ensemble forecast and EpiNow2 models
load_and_copy_forecasts(root_dir = here::here("submissions", "crowd-forecasts"),
out_file_path = here::here("crowd-forecast", "processed-forecast-data", "all-epiexpert-forecasts.csv"),
new_board_name = "EpiExpert-ensemble")

# also read all EpiNow2 forecasts, give them a board_name
folders <- list.files(here::here("submissions", "rt-forecasts/"))
files <- purrr::map(folders,
.f = function(folder_name) {
files <- list.files(here::here("submissions", "rt-forecasts/", folder_name))
paste(here::here("submissions", "rt-forecasts/", folder_name, files))
}) %>%
unlist()
epinow_forecasts <- purrr::map_dfr(files, readr::read_csv) %>%
dplyr::mutate(board_name = "EpiNow2",
submission_date = forecast_date,
horizon = as.numeric(gsub("([0-9]+).*$", "\\1", target))) %>%
dplyr::filter(grepl("inc", target),
type == "quantile")

data.table::fwrite(epinow_forecasts,
here::here("human-forecasts", "processed-forecast-data", "all-epinow2-forecasts.csv"))




load_and_copy_forecasts(root_dir = here::here("submissions", "rt-forecasts"),
out_file_path = here::here("crowd-forecast", "processed-forecast-data", "all-epinow2-forecasts.csv"),
new_board_name = "EpiNow2")

# also read all EpiNow2 secondary forecasts, give them a board_name
folders <- list.files(here::here("submissions", "deaths-from-cases/"))
files <- purrr::map(folders,
.f = function(folder_name) {
files <- list.files(here::here("submissions", "deaths-from-cases/", folder_name))
paste(here::here("submissions", "deaths-from-cases/", folder_name, files))
}) %>%
unlist()
epinow_forecasts <- purrr::map_dfr(files, readr::read_csv) %>%
dplyr::mutate(board_name = "EpiNow2_secondary",
submission_date = forecast_date,
horizon = as.numeric(gsub("([0-9]+).*$", "\\1", target))) %>%
dplyr::filter(grepl("inc", target),
type == "quantile")

data.table::fwrite(epinow_forecasts,
here::here("human-forecasts", "processed-forecast-data", "all-epinow2_secondary-forecasts.csv"))
load_and_copy_forecasts(root_dir = here::here("submissions", "deaths-from-cases"),
out_file_path = here::here("crowd-forecast", "processed-forecast-data", "all-epinow2_secondary-forecasts.csv"),
new_board_name = "EpiNow2_secondary")

# also read all EpiNow2 Rt crowd forecasts, give them a board_name
load_and_copy_forecasts(root_dir = here::here("submissions", "crowd-rt-forecasts"),
out_file_path = here::here("crowd-forecast", "processed-forecast-data", "all-crowd-rt-forecasts.csv"),
new_board_name = "Crowd-Rt-Forecast")


# also read all EpiNow2 Rt crowd forecasts, give them a board_name
folders <- list.files(here::here("submissions", "crowd-rt-forecasts/"))
files <- purrr::map(folders,
.f = function(folder_name) {
files <- list.files(here::here("submissions", "crowd-rt-forecasts/", folder_name))
paste(here::here("submissions", "crowd-rt-forecasts/", folder_name, files))
}) %>%
unlist()
epinow__crowd_forecasts <- purrr::map_dfr(files, readr::read_csv) %>%
dplyr::mutate(board_name = "Crowd-Rt-Forecast",
submission_date = forecast_date,
horizon = as.numeric(gsub("([0-9]+).*$", "\\1", target))) %>%
dplyr::filter(grepl("inc", target),
type == "quantile")

data.table::fwrite(epinow__crowd_forecasts,
here::here("human-forecasts", "processed-forecast-data", "all-crowd-rt-forecasts.csv"))


# load data --------------------------------------------------------------------
root_dir <- here::here("human-forecasts", "processed-forecast-data")
# load all data ----------------------------------------------------------------
root_dir <- here::here("crowd-forecast", "processed-forecast-data")
file_paths_forecast <- here::here(root_dir, list.files(root_dir))

prediction_data <- purrr::map_dfr(file_paths_forecast,
Expand All @@ -107,7 +71,6 @@ prediction_data <- purrr::map_dfr(file_paths_forecast,
location_name %in% c("Germany", "Poland")) %>%
dplyr::select(location, location_name, forecast_date, quantile, prediction, model, target_end_date, horizon, target, target_type)


files <- list.files("data-raw/")
file_paths <- paste0("data-raw/", files[grepl("weekly-incident", files)])
names(file_paths) <- c("case", "death")
Expand All @@ -128,15 +91,12 @@ The evaluations are also not authorised by the German Forecast Hub team.
If you have questions or want to give feedback, please create an issue on our
[github repository](https://github.com/epiforecasts/covid-german-forecasts).")


params <- list(locations = c("Germany", "Poland"),
forecast_dates = "all",
horizons = c(1:4),
target_types = "all",
intro_text = intro_text)



scoringutils::render_scoring_report(truth_data = truth_data,
document_title = "EpiExpert Crowd-Forecasting Performance Board",
params = params,
Expand Down

0 comments on commit 49603c9

Please sign in to comment.