diff --git a/DESCRIPTION b/DESCRIPTION index 4949e72..c14157f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: forecast-eval Title: Forecast Evaluation Dashboard -Version: 4.0 +Version: 4.1 Authors@R: person("Kate", "Harwood", role = c("cre")), person("Chris", "Scott", diff --git a/Report/create_reports.R b/Report/create_reports.R index fac3761..3d7cf39 100644 --- a/Report/create_reports.R +++ b/Report/create_reports.R @@ -24,7 +24,7 @@ prediction_cards_filepath = case_when( ) forecasters = unique(c(get_covidhub_forecaster_names(designations = c("primary", "secondary")), - "COVIDhub-baseline", "COVIDhub-trained_ensemble")) + "COVIDhub-baseline", "COVIDhub-trained_ensemble", "COVIDhub-4_week_ensemble")) locations = covidHubUtils::hub_locations # also includes "us", which is national level data diff --git a/dashboard/app.R b/dashboard/app.R index 1c97c74..3a35e05 100644 --- a/dashboard/app.R +++ b/dashboard/app.R @@ -212,7 +212,8 @@ ui <- fluidPage(padding=0, title="Forecast Eval Dashboard", ) -server <- function(input, output, session) { +# Get and prepare data +getS3Bucket <- function() { # Connect to AWS s3bucket Sys.setenv("AWS_DEFAULT_REGION" = "us-east-2") s3bucket = tryCatch( @@ -224,40 +225,95 @@ server <- function(input, output, session) { return(NULL) } ) + + return(s3bucket) +} - # Get and prepare data - getData <- function(filename){ - if(!is.null(s3bucket)) { - tryCatch( - { - s3readRDS(object = filename, bucket = s3bucket) - }, - error = function(e) { - e - getFallbackData(filename) - } - ) - } else { - getFallbackData(filename) - } +getData <- function(filename, s3bucket){ + if(!is.null(s3bucket)) { + tryCatch( + { + s3readRDS(object = filename, bucket = s3bucket) + }, + error = function(e) { + e + getFallbackData(filename) + } + ) + } else { + getFallbackData(filename) } +} - getFallbackData = function(filename) { - path = ifelse( - file.exists(filename), - filename, - file.path("../dist/",filename) - ) - readRDS(path) +getFallbackData = function(filename) { + path = ifelse( + file.exists(filename), + filename, + file.path("../dist/",filename) + ) + readRDS(path) +} + +getAllData = function(s3bucket) { + dfStateCases <- getData("score_cards_state_cases.rds", s3bucket) + dfStateDeaths <- getData("score_cards_state_deaths.rds", s3bucket) + dfNationCases = getData("score_cards_nation_cases.rds", s3bucket) + dfNationDeaths = getData("score_cards_nation_deaths.rds", s3bucket) + dfStateHospitalizations = getData("score_cards_state_hospitalizations.rds", s3bucket) + dfNationHospitalizations = getData("score_cards_nation_hospitalizations.rds", s3bucket) + + # Pick out expected columns only + covCols = paste0("cov_", COVERAGE_INTERVALS) + expectedCols = c("ahead", "geo_value", "forecaster", "forecast_date", + "data_source", "signal", "target_end_date", "incidence_period", + "actual", "wis", "sharpness", "ae", "value_50", + covCols) + + dfStateCases = dfStateCases %>% select(all_of(expectedCols)) + dfStateDeaths = dfStateDeaths %>% select(all_of(expectedCols)) + dfNationCases = dfNationCases %>% select(all_of(expectedCols)) + dfNationDeaths = dfNationDeaths %>% select(all_of(expectedCols)) + dfStateHospitalizations = dfStateHospitalizations %>% select(all_of(expectedCols)) + dfNationHospitalizations = dfNationHospitalizations %>% select(all_of(expectedCols)) + + df = rbind(dfStateCases, dfStateDeaths, dfNationCases, dfNationDeaths, dfStateHospitalizations, dfNationHospitalizations) + df = df %>% rename("10" = cov_10, "20" = cov_20, "30" = cov_30, "40" = cov_40, "50" = cov_50, "60" = cov_60, "70" = cov_70, "80" = cov_80, "90" = cov_90, "95" = cov_95, "98" = cov_98) + + return(df) +} + +getRecentDataHelper = function() { + s3bucket <- getS3Bucket() + df <- data.frame() + + getRecentData = function() { + newS3bucket <- getS3Bucket() + + s3Contents <- s3bucket[attr(s3bucket, "names", exact=TRUE)] + newS3Contents <- newS3bucket[attr(newS3bucket, "names", exact=TRUE)] + + # Fetch new score data if contents of S3 bucket has changed (including file + # names, sizes, and last modified timestamps). Ignores characteristics of + # bucket and request, including bucket region, name, content type, request + # date, request ID, etc. + if ( nrow(df) == 0 || !identical(s3Contents, newS3Contents) ) { + # Save new data and new bucket connection info to vars in env of + # `getRecentDataHelper`. They persist between calls to `getRecentData` a + # la https://stackoverflow.com/questions/1088639/static-variables-in-r + s3bucket <<- newS3bucket + df <<- getAllData(s3bucket) + } + + return(df) } + + return(getRecentData) +} - dfStateCases <- getData("score_cards_state_cases.rds") - dfStateDeaths <- getData("score_cards_state_deaths.rds") - dfNationCases = getData("score_cards_nation_cases.rds") - dfNationDeaths = getData("score_cards_nation_deaths.rds") - dfStateHospitalizations = getData("score_cards_state_hospitalizations.rds") - dfNationHospitalizations = getData("score_cards_nation_hospitalizations.rds") - DATA_LOADED = TRUE +getRecentData <- getRecentDataHelper() + + +server <- function(input, output, session) { TERRITORIES = c('AS', 'GU', 'MP', 'VI') PREV_AS_OF_DATA = reactiveVal(NULL) AS_OF_CHOICES = reactiveVal(NULL) @@ -276,24 +332,10 @@ server <- function(input, output, session) { CURRENT_WEEK_END_DATE = reactiveVal(CASES_DEATHS_CURRENT) prevHospWeek <- seq(Sys.Date()-11,Sys.Date()-5,by='day') HOSP_CURRENT = prevHospWeek[weekdays(prevHospWeek)=='Wednesday'] - - - # Pick out expected columns only - covCols = paste0("cov_", COVERAGE_INTERVALS) - expectedCols = c("ahead", "geo_value", "forecaster", "forecast_date", - "data_source", "signal", "target_end_date", "incidence_period", - "actual", "wis", "sharpness", "ae", "value_50", - covCols) - - dfStateCases = dfStateCases %>% select(all_of(expectedCols)) - dfStateDeaths = dfStateDeaths %>% select(all_of(expectedCols)) - dfNationCases = dfNationCases %>% select(all_of(expectedCols)) - dfNationDeaths = dfNationDeaths %>% select(all_of(expectedCols)) - dfStateHospitalizations = dfStateHospitalizations %>% select(all_of(expectedCols)) - dfNationHospitalizations = dfNationHospitalizations %>% select(all_of(expectedCols)) - df = rbind(dfStateCases, dfStateDeaths, dfNationCases, dfNationDeaths, dfStateHospitalizations, dfNationHospitalizations) - df = df %>% rename("10" = cov_10, "20" = cov_20, "30" = cov_30, "40" = cov_40, "50" = cov_50, "60" = cov_60, "70" = cov_70, "80" = cov_80, "90" = cov_90, "95" = cov_95, "98" = cov_98) + # Get scores + df = getRecentData() + DATA_LOADED = TRUE # Prepare input choices forecasterChoices = sort(unique(df$forecaster)) diff --git a/docker_dashboard/Dockerfile b/docker_dashboard/Dockerfile index db5e57b..85d93b8 100644 --- a/docker_dashboard/Dockerfile +++ b/docker_dashboard/Dockerfile @@ -1,9 +1,20 @@ FROM rocker/shiny-verse LABEL org.opencontainers.image.source = "https://github.com/cmu-delphi/forecast-eval" +RUN apt-get update && apt-get install -qq -y \ + libgdal-dev \ + libudunits2-dev ADD docker_dashboard/shiny_server.conf /etc/shiny-server/shiny-server.conf -RUN install2.r plotly shinyjs tsibble viridis aws.s3 covidcast stringr +RUN install2.r --error \ + plotly \ + shinyjs \ + tsibble \ + viridis \ + aws.s3 \ + covidcast \ + stringr \ + markdown COPY dist/*rds /srv/shiny-server/ COPY dashboard/* /srv/shiny-server/