call validation once to reduce calls to "duplicate"

Author: nmdefries

backfill_corrections/delphiBackfillCorrection/R/main.R

@@ -324,15 +324,12 @@ main <- function(params,
 
     # Check data type and required columns
     msg_ts("Validating input data")
-    for (value_type in params$value_types) {
-      msg_ts("for ", value_type)
-      result <- validity_checks(
-        input_data, value_type,
-        params$num_col, params$denom_col, input_group$name_suffix,
-        refd_col = refd_col, lag_col = lag_col, issued_col = issued_col
-      )
-      input_data <- result[["df"]]
-    }
+    # Validate while date fields still stored as strings for speed.
+    input_data <- validity_checks(
+      input_data, params$value_types,
+      params$num_col, params$denom_col, input_group$name_suffix,
+      refd_col = refd_col, lag_col = lag_col, issued_col = issued_col
+    )
 
     input_data[[refd_col]] <- as.Date(input_data[[refd_col]], "%Y-%m-%d")
     input_data[[issued_col]] <- as.Date(input_data[[issued_col]], "%Y-%m-%d")

backfill_corrections/delphiBackfillCorrection/R/utils.R

@@ -122,7 +122,8 @@ create_dir_not_exist <- function(path)
 #' Check input data for validity
 #'
 #' @template df-template
-#' @template value_type-template
+#' @param value_types character vector of all signal types to process. Either
+#'   or both of "count" and "fraction".
 #' @template num_col-template
 #' @template denom_col-template
 #' @template signal_suffixes-template
@@ -133,18 +134,20 @@ create_dir_not_exist <- function(path)
 #' @return list of input dataframe augmented with lag column, if it
 #'     didn't already exist, and character vector of one or two value
 #'     column names, depending on requested `value_type`
-validity_checks <- function(df, value_type, num_col, denom_col, signal_suffixes,
+validity_checks <- function(df, value_types, num_col, denom_col, signal_suffixes,
                             refd_col = "time_value", lag_col = "lag", issued_col = "issue_date") {
   if (!missing(signal_suffixes) && !is.na(signal_suffixes) && !all(signal_suffixes == "") && !all(is.na(signal_suffixes))) {
     num_col <- paste(num_col, signal_suffixes, sep = "_")
     denom_col <- paste(denom_col, signal_suffixes, sep = "_")
   }
 
   # Check data type and required columns
-  if (value_type == "count") {
-    if ( all(num_col %in% colnames(df)) ) { value_cols=c(num_col) }
-    else { stop("No valid column name detected for the count values!") }
-  } else if (value_type == "fraction") {
+  if ("count" %in% value_types) {
+    if ( !all(num_col %in% colnames(df)) ) {
+      stop("No valid column name detected for the count values!")
+    }
+  }
+  if ("fraction" %in% value_types) {
     value_cols = c(num_col, denom_col)
     if ( !all(value_cols %in% colnames(df)) ) {
       stop("No valid column name detected for the fraction values!")
@@ -157,7 +160,7 @@ validity_checks <- function(df, value_type, num_col, denom_col, signal_suffixes,
   }
 
   # issue_date and lag should exist in the dataset
-  if ( !(lag_col %in% colnames(df)) || !(issued_col %in% colnames(df)) ) {
+  if ( !all(c(lag_col, issued_col) %in% colnames(df)) ) {
     stop("Issue date and lag fields must exist in the input data")
   }
 
@@ -178,7 +181,7 @@ validity_checks <- function(df, value_type, num_col, denom_col, signal_suffixes,
          " least one reference date-issue date-location combination")
   }
 
-  return(list(df = df, value_cols = value_cols))
+  return(df)
 }
 
 #' Check available training days

backfill_corrections/delphiBackfillCorrection/man/validity_checks.Rd

@@ -158,7 +158,7 @@ test_that("validity_checks alerts appropriately", {
   geo_value = rep("01001", 3)
 
   check_wrapper <- function(df, value_type, signal_suffixes = "") {
-    validity_checks(df, value_type = value_type, num_col = "num",
+    validity_checks(df, value_types = value_type, num_col = "num",
       denom_col = "den", signal_suffixes = signal_suffixes)
   }
 
@@ -179,8 +179,6 @@ test_that("validity_checks alerts appropriately", {
 
   expect_error(check_wrapper(data.frame(num, den), "count"),
     "No reference date column detected for the reference date!")
-  expect_error(check_wrapper(data.frame(num, den, time_value = as.character(time_value)), "count"),
-    "Reference date column must be of `Date` type")
 
 
   issued_lag_error <- "Issue date and lag fields must exist in the input data"
@@ -205,10 +203,6 @@ test_that("validity_checks alerts appropriately", {
   expect_error(check_wrapper(bind_rows(df, new_row), "count"), missing_val_error)
 
 
-  expect_error(check_wrapper(data.frame(num, den, time_value, lag, issue_date = as.character(issue_date)), "count"),
-    "Issue date column must be of `Date` type")
-
-
   df <- data.frame(num, den, time_value, issue_date, lag, geo_value, state_id)
   expect_warning(check_wrapper(df[rep(1, 3), ], "count"),
     "Data contains duplicate rows, dropping")