Merge pull request #659 from cmu-delphi/ndefries/no-cumulative-sum

Don't sum cumulative truth values

Author: dshemetov

R-packages/evalcast/DESCRIPTION

@@ -1,7 +1,7 @@
 Package: evalcast
 Type: Package
 Title: Tools For Evaluating COVID Forecasters
-Version: 0.3.4
+Version: 0.3.5
 Authors@R:
   c(
     person(given = "Daniel",

R-packages/evalcast/NEWS.md

@@ -1,3 +1,10 @@
+# evalcast 0.3.5
+
+- Fix truth value generation for cumulative signals. `get_target_response` now
+  returns the most recent value within a given time period for either a `day`
+  or `epiweek` incidence period. For incidence signals, `get_target_response`
+  still sums all values within the time period.
+
 # evalcast 0.3.4
 
 - Change `get_forecaster_predictions_alt` to read forecaster input files using

R-packages/evalcast/R/get_target_response.R

@@ -85,20 +85,30 @@ get_target_response <- function(signals,
                    "forecast dates: ",
                    paste(forecast_dates[problem_dates], collapse = ", "),
                    "."))
-    if (sum(problem_dates) == length(forecast_dates)) return(empty_actual())
+    if (length(problem_dates) == length(forecast_dates)) return(empty_actual())
     out <- out[!problem_dates]
     forecast_dates <- forecast_dates[!problem_dates]
     target_periods <- target_periods[!problem_dates, ]
   }
   names(out) <- forecast_dates
   target_periods$forecast_date = lubridate::ymd(forecast_dates)
+
+  if (grepl("cumulative", response$signal, fixed=TRUE)) {
+    agg_fn <- function(df) {
+      slice(df, which.max(time_value)) %>% select(geo_value, forecast_date, actual = value)
+    }
+  } else {
+    agg_fn <- function(df) {
+      summarize(df, actual = sum(.data$value))
+    }
+  }
   out <- out %>%
     bind_rows(.id = "forecast_date") %>%
     mutate(forecast_date = lubridate::ymd(.data$forecast_date)) %>%
     group_by(.data$geo_value, .data$forecast_date) %>%
-    summarize(actual = sum(.data$value)) %>%
-    #    mutate(forecast_date = forecast_dates[as.numeric(.data$forecast_date)]) %>%
+    agg_fn() %>%
     left_join(target_periods, by = "forecast_date")
+
   # record date that this function was run for reproducibility
   attr(out, "as_of") <- Sys.Date()
   out