From 4e1d27cb71367476b783ac651a5ea7418ee2b5a4 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Tue, 12 Oct 2021 14:30:34 -0400 Subject: [PATCH 1/3] small code fixes --- dashboard/app.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/dashboard/app.R b/dashboard/app.R index f489412..0b0c08d 100644 --- a/dashboard/app.R +++ b/dashboard/app.R @@ -889,7 +889,7 @@ server <- function(input, output, session) { # Ensure there is always one forecaster selected if(length(input$forecasters) < 1) { updateSelectInput(session, "forecasters", - selected = c("COVIDhub-ensemble")) # Use ensemble rather than baseline bc it has hospitalization scores + selected = c("COVIDhub-baseline")) } # Ensure COVIDhub-baseline is selected when scaling by baseline if(input$scaleByBaseline && !("COVIDhub-baseline" %in% input$forecasters)) { @@ -954,14 +954,12 @@ server <- function(input, output, session) { selectedAsOf = isolate(input$asOf) if (input$targetVariable == "Hospitalizations") { minChoice = MIN_AVAIL_HOSP_AS_OF_DATE - asOfChoices = asOfChoices[asOfChoices >= minChoice] } else if(input$location == 'US' && input$scoreType != 'coverage') { minChoice = MIN_AVAIL_NATION_AS_OF_DATE - asOfChoices = asOfChoices[asOfChoices >= minChoice] } else if(input$location %in% TERRITORIES || input$location == TOTAL_LOCATIONS || input$scoreType == 'coverage') { minChoice = MIN_AVAIL_TERRITORY_AS_OF_DATE - asOfChoices = asOfChoices[asOfChoices >= minChoice] } + asOfChoices = asOfChoices[asOfChoices >= minChoice] asOfChoices = c(asOfChoices, CURRENT_WEEK_END_DATE()) # Make sure we have a valid as of selection nonValidAsOf = selectedAsOf == '' || !(as.Date(selectedAsOf) %in% asOfChoices) From 4307e85a6c6cdcfc3a6f8843ba4da18af9f7b25f Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Fri, 15 Oct 2021 14:36:15 -0400 Subject: [PATCH 2/3] simplify and clarify filters, dim, joins --- app/server.R | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/app/server.R b/app/server.R index c8a08ee..6c1df8e 100644 --- a/app/server.R +++ b/app/server.R @@ -118,7 +118,7 @@ server <- function(input, output, session) { } # Need to do this after setting dfWithForecasts to leave in aheads for forecasts filteredScoreDf <- filteredScoreDf %>% filter(ahead %in% input$aheads) - if (dim(filteredScoreDf)[1] == 0) { + if (nrow(filteredScoreDf) == 0) { output$renderWarningText <- renderText(paste0( "The selected forecasters do not have enough data ", "to display the selected scoring metric." @@ -126,23 +126,23 @@ server <- function(input, output, session) { return() } if (is.null(asOfData)) { - if (!is.null(isolate(PREV_AS_OF_DATA())) && dim(isolate(PREV_AS_OF_DATA()))[1] != 0 && + if (!is.null(isolate(PREV_AS_OF_DATA())) && nrow(isolate(PREV_AS_OF_DATA())) != 0 && isolate(input$asOf) != "" && isolate(input$asOf) != isolate(CURRENT_WEEK_END_DATE())) { asOfData <- isolate(PREV_AS_OF_DATA()) } } - if (!is.null(asOfData) && dim(asOfData)[1] != 0) { + if (!is.null(asOfData) && nrow(asOfData) != 0) { asOfData <- asOfData %>% rename(target_end_date = time_value, as_of_actual = value) asOfData <- asOfData[c("target_end_date", "geo_value", "as_of_actual")] # Get the 'as of' dates that are the target_end_dates in the scoring df dateGroupDf <- asOfData %>% filter(asOfData$target_end_date %in% filteredScoreDf$target_end_date) - if (dim(dateGroupDf)[1] != 0) { + if (nrow(dateGroupDf) != 0) { # Since cases and deaths are shown as weekly incidence, but the "as of" data from the covidcast API # is daily, we need to sum over the days leading up to the target_end_date of each week to get the # weekly incidence asOfData <- filterAsOfData(asOfData, dateGroupDf, filteredScoreDf) - filteredScoreDf <- merge(filteredScoreDf, asOfData, by = c("target_end_date", "geo_value"), all = TRUE) + filteredScoreDf <- full_join(filteredScoreDf, asOfData, by = c("target_end_date", "geo_value")) } else { # Input 'as of' date chosen does not match the available target_end_dates that result from the rest of the selected inputs # It is too far back or we are switching between hosp and cases/deaths which have different target date days @@ -239,9 +239,10 @@ server <- function(input, output, session) { updateAsOfChoices(session, truthDf) # Format and transform data for plot - filteredScoreDf <- filteredScoreDf %>% filter(!is.na(Week_End_Date)) - filteredScoreDf <- filteredScoreDf[c("Forecaster", "Forecast_Date", "Week_End_Date", "Score", "ahead")] - filteredScoreDf <- filteredScoreDf %>% mutate(across(where(is.numeric), ~ round(., 2))) + filteredScoreDf <- filteredScoreDf %>% + filter(!is.na(Week_End_Date)) %>% + select(Forecaster, Forecast_Date, Week_End_Date, Score, ahead) %>% + mutate(across(where(is.numeric), ~ round(., 2))) if (input$scoreType != "coverage") { if (input$scaleByBaseline) { baselineDf <- filteredScoreDf %>% filter(Forecaster %in% "COVIDhub-baseline") @@ -450,12 +451,13 @@ server <- function(input, output, session) { # Create a df to fill in the corresponding target_end_date in a new date_group column for all intervening days dateGroupDf[, "date_group"] <- NA dateGroupDf$date_group <- dateGroupDf$target_end_date - asOfData <- merge(asOfData, dateGroupDf, by = c("target_end_date", "geo_value", "as_of_actual"), all = TRUE) + asOfData <- full_join(asOfData, dateGroupDf, by = c("target_end_date", "geo_value", "as_of_actual")) # Cut off the extra days on beginning and end of series so that when we sum the values we are only # summing over the weeks included in the score plot - asOfData <- asOfData %>% filter(target_end_date >= min(filteredScoreDf$target_end_date) - 6) - asOfData <- asOfData %>% filter(target_end_date <= isolate(input$asOf)) + asOfData <- asOfData %>% + filter(target_end_date >= min(filteredScoreDf$target_end_date) - 6) %>% + filter(target_end_date <= isolate(input$asOf)) # Fill in the date_group column with the target week end days for all intervening days asOfData <- asOfData %>% @@ -735,7 +737,7 @@ server <- function(input, output, session) { hideElement("truth-plot-loading-message") PREV_AS_OF_DATA(asOfTruthData) - if (dim(asOfTruthData)[1] == 0) { + if (nrow(asOfTruthData) == 0) { return() } summaryPlot(reRenderTruth = TRUE, asOfData = asOfTruthData) @@ -749,12 +751,14 @@ server <- function(input, output, session) { selectedAsOf <- isolate(input$asOf) if (input$targetVariable == "Hospitalizations") { minChoice <- MIN_AVAIL_HOSP_AS_OF_DATE + asOfChoices <- asOfChoices[asOfChoices >= minChoice] } else if (input$location == "US" && input$scoreType != "coverage") { minChoice <- MIN_AVAIL_NATION_AS_OF_DATE + asOfChoices <- asOfChoices[asOfChoices >= minChoice] } else if (input$location %in% TERRITORIES || input$location == TOTAL_LOCATIONS || input$scoreType == "coverage") { minChoice <- MIN_AVAIL_TERRITORY_AS_OF_DATE + asOfChoices <- asOfChoices[asOfChoices >= minChoice] } - asOfChoices <- asOfChoices[asOfChoices >= minChoice] asOfChoices <- c(asOfChoices, CURRENT_WEEK_END_DATE()) # Make sure we have a valid as of selection nonValidAsOf <- selectedAsOf == "" || !(as.Date(selectedAsOf) %in% asOfChoices) From 6b1d0067cef69ba0b5eef95fd62ad0106f44a0b2 Mon Sep 17 00:00:00 2001 From: Nat DeFries <42820733+nmdefries@users.noreply.github.com> Date: Fri, 15 Oct 2021 16:15:16 -0400 Subject: [PATCH 3/3] move height setting, remove shape setting to fix plotting warnings --- app/server.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/app/server.R b/app/server.R index 6c1df8e..ed1846e 100644 --- a/app/server.R +++ b/app/server.R @@ -319,12 +319,10 @@ server <- function(input, output, session) { } plotHeight <- 550 + (length(input$aheads) - 1) * 100 finalPlot <- - ggplotly(p, tooltip = c("x", "y", "shape", "label")) %>% + ggplotly(p, tooltip = c("x", "y", "shape", "label"), height = plotHeight) %>% layout( - height = plotHeight, legend = list(orientation = "h", y = -0.1), margin = list(t = 90), - height = 500, hovermode = "x unified", xaxis = list( title = list(text = "Target Date", standoff = 8L), @@ -380,7 +378,7 @@ server <- function(input, output, session) { geom_point(aes(y = Reported_As_Of_Incidence, color = "Reported_As_Of_Incidence")) if (input$showForecasts) { finalPlot <- finalPlot + - geom_line(aes(y = Quantile_50, color = Forecaster, shape = Forecaster)) + + geom_line(aes(y = Quantile_50, color = Forecaster)) + geom_point(aes(y = Quantile_50, color = Forecaster, shape = Forecaster)) } } else {