Merge pull request #69 from cmu-delphi/release_v1.1

Release_V1.1

Author: kateharwood

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: forecast-eval
 Title: Forecast Evaluation Dashboard
-Version: 0.1
+Version: 1.1
 Authors@R: person("Kate", "Harwood",
                   role = c("cre")), 
 	   person("Chris", "Scott",

README.md

@@ -34,3 +34,18 @@ To start a docker image of the shiny server locally:
 ```bash
 > make start_dashboard
 ```
+
+# Releasing
+```
+git checkout dev
+git pull
+git checkout -b release_v1.0 origin/dev
+```
+Update version number in DESCRIPTION FILE
+```
+git add .
+git commit -m "Version 1.0 updates"
+git tag -a v1.0 -m "Version 1.0"
+git push origin release_v1.0
+git push origin v1.0
+```

Report/predictions.R

@@ -7,7 +7,7 @@ library(stringr)
 create_prediction_cards = function(prediction_cards_filename){
   start_date = today() - 100 * 7 # last 100 weeks
 
-  forecasters = get_covidhub_forecaster_names()
+  forecasters = get_covidhub_forecaster_names(designations = "primary")
   num_forecasters = length(forecasters)
   print(str_interp("Getting forecasts for ${num_forecasters} forecasters."))
 
@@ -20,7 +20,10 @@ create_prediction_cards = function(prediction_cards_filename){
     error = function(e) cat(sprintf("%i. %s\n", i, e$message))
     )
   }
-  
+  # Convert NULL to empty vector. Useful when a model has no forecasts,
+  # resulting in a 404 and no forecast_dates.
+  forecast_dates = lapply(forecast_dates,
+                          function(dates) if (is.null(dates)) Date() else dates)
   forecast_dates = lapply(forecast_dates, function(date) date[date >= start_date])
 
   # Load data from previous run so we don't have to re-ingest / process it. This
@@ -43,19 +46,14 @@ create_prediction_cards = function(prediction_cards_filename){
   new_dates = list()
   for (i in 1:length(forecasters)) {
     given_dates = forecast_dates[[i]]
-    # dates must be on a Sunday or Monday
-    comparable_forecast_dates = given_dates[wday(given_dates) %in% c(1,2)]
-    
-    # ...but only include Monday if both dates included
-    comparable_forecast_dates = comparable_forecast_dates[!((comparable_forecast_dates + 1) %in% comparable_forecast_dates)]
     if(exists("seen_dates")){
       if(forecasters[[i]] %in% seen_dates$forecaster){
         seen_forecaster_dates = (seen_dates %>% 
                                    filter(forecaster == forecasters[[i]]))$forecast_date
-        comparable_forecast_dates = as_date(setdiff(comparable_forecast_dates, seen_forecaster_dates))
+        given_dates = as_date(setdiff(given_dates, seen_forecaster_dates))
       }
     }
-    new_dates[[i]] = comparable_forecast_dates
+    new_dates[[i]] = given_dates
   }
 
   names(new_dates) = forecasters
@@ -89,6 +87,15 @@ create_prediction_cards = function(prediction_cards_filename){
                         filter(forecast_date >= start_date) %>%
                         filter(!is.na(predictions_cards$target_end_date)) 
 
+  # Only accept forecasts made Monday or earlier
+  predictions_cards = predictions_cards %>%
+                        filter(target_end_date - (forecast_date + 7 * ahead) >= -2)
+  
+  # And only a forecaster's last forecast if multiple were made
+  predictions_cards = predictions_cards %>% 
+                        group_by(forecaster, geo_value, target_end_date, quantile, ahead, signal) %>%
+                        filter(forecast_date == max(forecast_date))
+  
   saveRDS(predictions_cards,
           file = prediction_cards_filename, 
           compress = "xz")

Report/score.R

@@ -56,9 +56,8 @@ create_score_cards = function(prediction_cards_filepath, geo_type, signal_name =
   }
 
   if(nrow(preds_to_eval) > 0){
-    score_cards = evaluate_predictions(preds_to_eval, 
+    score_cards = evaluate_covid_predictions(preds_to_eval, 
                                            err_measures,
-                                           backfill_buffer = 0,
                                            geo_type = geo_type)
     # filter out scores that couldn't be evaluated to try to evaluate with
     # covidHubUtils.

dashboard/about-dashboard.md

@@ -1 +1 @@
-This dashboard was developed by [CMU Delphi](https://delphi.cmu.edu) in collaboration with the [Reich Lab](https://reichlab.io) and US [COVID-19 Forecast Hub](https://covid19forecasthub.org/) from UMass-Amherst, as part of the Forecast Evaluation Research Collaborative.
+This app collects and scores COVID-19 forecasts submitted to the CDC. The dashboard was developed by [CMU Delphi](https://delphi.cmu.edu) in collaboration with the [Reich Lab](https://reichlab.io) and US [COVID-19 Forecast Hub](https://covid19forecasthub.org/) from UMass-Amherst, as part of the Forecast Evaluation Research Collaborative.

dashboard/app.R

@@ -322,24 +322,40 @@ server <- function(input, output, session) {
 
     filteredScoreDf$ahead = factor(filteredScoreDf$ahead, levels = c(1, 2, 3, 4), 
                                     labels = c("Horizon: 1 Week", "Horizon: 2 Weeks", "Horizon: 3 Weeks", "Horizon: 4 Weeks"))
-    p = ggplot(filteredScoreDf, aes(x = Week_End_Date, y = Score, color = Forecaster, linetype = Forecaster)) +
+    p = ggplot(
+        filteredScoreDf, 
+        aes(x = Week_End_Date, y = Score, color = Forecaster, shape = Forecaster)
+      ) +
       geom_line() +
-      geom_point() +
+      geom_point(size=2) +
       labs(x = "", y = "", title=titleText) +
       scale_x_date(date_labels = "%b %Y") +
       scale_y_continuous(limits = c(0,NA), labels = scales::comma) +
       facet_wrap(~ahead, ncol=1) +
-      scale_color_manual(values = color_palette)
+      scale_color_manual(values = color_palette) +
+      theme_bw() + 
+      theme(panel.spacing=unit(0.5, "lines"))
 
     if (scoreType == "coverage") {
       p = p + geom_hline(yintercept = .01 * as.integer(coverageInterval))
     }
     plotHeight = 550 + (length(horizon)-1)*100
-    return(ggplotly(p + theme_bw() + theme(panel.spacing=unit(0.5, "lines")), tooltip = c("x", "y", "linetype"))
-           %>% 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), titlefont = list(size = 12))) 
-           %>% config(displayModeBar = F))
+    
+    finalPlot <- 
+      ggplotly(p,tooltip = c("x", "y", "shape")) %>% 
+      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), 
+          titlefont = list(size = 12))
+      ) %>%
+      config(displayModeBar = F)
+      
+    return(finalPlot)
   }
 
   # Create the plot for target variable ground truth