diff --git a/app/server.R b/app/server.R index 194cf62..ed1846e 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") @@ -318,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), @@ -379,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 { @@ -450,12 +449,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 %>% @@ -678,8 +678,8 @@ 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)) { @@ -735,7 +735,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)