Merge pull request #136 from cmu-delphi/forecastdate-tooltip-label

Forecastdate tooltip label

Author: kateharwood

dashboard/app.R

@@ -267,7 +267,8 @@ server <- function(input, output, session) {
       filter(ahead %in% horizon) %>%
       filter(forecaster %in% forecasters)
 
-    filteredScoreDf <- scoreDf %>% rename(Forecaster = forecaster, Week_End_Date = target_end_date)
+    filteredScoreDf <- scoreDf %>% rename(Forecaster = forecaster, Forecast_Date = forecast_date,
+                                          Week_End_Date = target_end_date)
 
     if (scoreType == "wis" || scoreType == "sharpness") {
       # Only show WIS or Sharpness for forecasts that have all intervals
@@ -315,14 +316,14 @@ server <- function(input, output, session) {
       if (scoreType == "coverage") {
         aggregate = "Averaged"
         filteredScoreDf = filteredScoreDf %>%
-          group_by(Forecaster, Week_End_Date, ahead) %>%
+          group_by(Forecaster, Forecast_Date, Week_End_Date, ahead) %>%
           summarize(Score = sum(Score)/length(locationsIntersect), actual = sum(actual))
         output$renderAggregateText = renderText(paste(aggregateText," Some forecasters may not have any data for the coverage interval chosen. Locations inlcuded: "))
       }
       else {
         aggregate = "Totaled"
         filteredScoreDf = filteredScoreDf %>%
-          group_by(Forecaster, Week_End_Date, ahead) %>%
+          group_by(Forecaster, Forecast_Date, Week_End_Date, ahead) %>%
           summarize(Score = sum(Score), actual = sum(actual))
         output$renderAggregateText = renderText(paste(aggregateText, " Locations included: "))
       }
@@ -342,7 +343,7 @@ server <- function(input, output, session) {
     # Not totaling over all locations
     } else {
       filteredScoreDf <- filteredScoreDf %>% filter(geo_value == tolower(loc)) %>%
-        group_by(Forecaster, Week_End_Date, ahead) %>%
+        group_by(Forecaster, Forecast_Date, Week_End_Date, ahead) %>%
         summarize(Score = Score, actual = actual)
       locationSubtitleText = paste0(', Location: ', input$location)
       output$renderAggregateText = renderText("")
@@ -359,7 +360,7 @@ server <- function(input, output, session) {
     })
 
     # Format and transform data
-    filteredScoreDf = filteredScoreDf[c("Forecaster", "Week_End_Date", "Score", "ahead")]
+    filteredScoreDf = filteredScoreDf[c("Forecaster", "Forecast_Date", "Week_End_Date", "Score", "ahead")]
     filteredScoreDf = filteredScoreDf %>% mutate(across(where(is.numeric), ~ round(., 2)))
     if (scoreType != 'coverage') {
       if (scaleByBaseline) {
@@ -368,8 +369,8 @@ server <- function(input, output, session) {
         # Scaling score by baseline forecaster
         filteredScoreDfMerged$Score.x = filteredScoreDfMerged$Score.x / filteredScoreDfMerged$Score.y
         filteredScoreDf = filteredScoreDfMerged %>%
-          rename(Forecaster = Forecaster.x, Score = Score.x) %>%
-          select(Forecaster, Week_End_Date, ahead, Score)
+          rename(Forecaster = Forecaster.x, Score = Score.x, Forecast_Date = Forecast_Date.x) %>%
+          select(Forecaster, Forecast_Date, Week_End_Date, ahead, Score)
       }
       if (logScale) {
         filteredScoreDf$Score = log10(filteredScoreDf$Score)
@@ -384,7 +385,7 @@ server <- function(input, output, session) {
     # Fill gaps so there are line breaks on weeks without data
     filteredScoreDf = filteredScoreDf %>%
       as_tsibble(key = c(Forecaster, ahead), index = Week_End_Date) %>%
-      group_by(Forecaster, ahead) %>%
+      group_by(Forecaster, Forecast_Date, ahead) %>%
       fill_gaps(.full = TRUE)
 
     filteredScoreDf$ahead = factor(filteredScoreDf$ahead, levels = c(1, 2, 3, 4), 
@@ -395,7 +396,7 @@ server <- function(input, output, session) {
 
     p = ggplot(
         filteredScoreDf, 
-        aes(x = Week_End_Date, y = Score, color = Forecaster, shape = Forecaster)
+        aes(x = Week_End_Date, y = Score, color = Forecaster, shape = Forecaster, label = Forecast_Date)
       ) +
       geom_line() +
       geom_point(size=2) +
@@ -417,7 +418,7 @@ server <- function(input, output, session) {
     }
     plotHeight = 550 + (length(horizon)-1)*100
     finalPlot <- 
-      ggplotly(p,tooltip = c("x", "y", "shape")) %>% 
+      ggplotly(p, tooltip = c("x", "y", "shape", "label")) %>%
       layout(
         height = plotHeight, 
         legend = list(orientation = "h", y = -0.1),