Harden validation and preprocessing edge cases

R/att_gt.R

@@ -302,10 +302,34 @@ att_gt <- function(yname,
   # Capture extra arguments for custom est_method
   extra_args <- list(...)
 
+  if (missing(control_group)) control_group <- "nevertreated"
+  validate_choice_scalar(
+    control_group,
+    "control_group",
+    c("nevertreated", "notyettreated"),
+    "control_group must be either 'nevertreated' or 'notyettreated'"
+  )
+  validate_choice_scalar(
+    base_period,
+    "base_period",
+    c("universal", "varying"),
+    "base_period must be either 'universal' or 'varying'."
+  )
+
   # Validate compute_inffunc (point-estimates-only switch)
   if (!is.logical(compute_inffunc) || length(compute_inffunc) != 1 || is.na(compute_inffunc)) {
     stop("compute_inffunc must be a single logical (TRUE or FALSE).")
   }
+  validate_logical_scalar(panel, "panel")
+  validate_logical_scalar(allow_unbalanced_panel, "allow_unbalanced_panel")
+  validate_logical_scalar(bstrap, "bstrap")
+  validate_logical_scalar(cband, "cband")
+  validate_logical_scalar(faster_mode, "faster_mode")
+  validate_logical_scalar(print_details, "print_details")
+  validate_logical_scalar(pl, "pl")
+  validate_positive_whole_number(cores, "cores")
+  validate_anticipation(anticipation)
+  validate_alp(alp)
   # When influence functions are not computed there are no standard errors, no
   # uniform bands, and no parallel-trends pre-test, so the bootstrap is moot.
   if (!compute_inffunc) {
@@ -356,17 +380,9 @@ att_gt <- function(yname,
     stop("Must provide idname when panel = TRUE. Set panel = FALSE for repeated cross sections.")
   }
 
-  # Validate alp (significance level)
-  if (!is.numeric(alp) || length(alp) != 1 || is.na(alp) || alp <= 0 || alp >= 1) {
-    stop("alp must be a single number strictly between 0 and 1.")
-  }
-
   # Validate biters (number of bootstrap iterations) when the bootstrap is used
   if (bstrap) {
-    if (!is.numeric(biters) || length(biters) != 1 || is.na(biters) ||
-        biters < 1 || biters != round(biters)) {
-      stop("biters must be a single positive whole number.")
-    }
+    validate_positive_whole_number(biters, "biters")
   }
 
   # Warn users about anticipation and never-treated units

R/compute.aggte.R

@@ -24,6 +24,10 @@ compute.aggte <- function(MP,
                           alp = NULL,
                           clustervars = NULL,
                           call = NULL) {
+  if (!inherits(MP, "MP")) {
+    stop("MP must be an MP object produced by att_gt().")
+  }
+
   #-----------------------------------------------------------------------------
   # unpack MP object
   #-----------------------------------------------------------------------------
@@ -35,13 +39,33 @@ compute.aggte <- function(MP,
   inffunc1 <- MP$inffunc
   n <- MP$n
 
+  validate_logical_scalar(na.rm, "na.rm")
+  validate_choice_scalar(
+    type,
+    "type",
+    c("simple", "dynamic", "group", "calendar"),
+    '`type` must be one of c("simple", "dynamic", "group", "calendar")'
+  )
+  validate_numeric_scalar(min_e, "min_e")
+  validate_numeric_scalar(max_e, "max_e")
+  if (!is.null(balance_e)) validate_nonnegative_whole_number(balance_e, "balance_e")
+
   # aggte() needs the influence functions to aggregate and to compute standard errors.
   # They are absent when att_gt() was run with compute_inffunc = FALSE (point estimates only).
   if (is.null(inffunc1)) {
     stop("This att_gt() result was produced with compute_inffunc = FALSE (point estimates ",
          "only), so it has no influence functions and cannot be aggregated by aggte(). ",
          "Re-run att_gt() with compute_inffunc = TRUE (the default) to use aggte().")
   }
+  if (length(group) != length(t) || length(att) != length(group)) {
+    stop("MP object has inconsistent group, time, and att lengths.")
+  }
+  if (NCOL(inffunc1) != length(att)) {
+    stop("MP object has inconsistent influence-function columns and att estimates.")
+  }
+  if (!is.null(n) && NROW(inffunc1) != n) {
+    stop("MP object has inconsistent influence-function rows and n.")
+  }
 
 
   gname <- dp$gname
@@ -93,6 +117,10 @@ compute.aggte <- function(MP,
   if (is.null(cband)) {
     cband <- dp$cband
   }
+  validate_logical_scalar(bstrap, "bstrap")
+  validate_logical_scalar(cband, "cband")
+  validate_alp(alp)
+  if (bstrap || cband) validate_positive_whole_number(biters, "biters")
   if (isTRUE(dp$faster_mode)) {
     tlist <- dp$time_periods
     glist <- dp$treated_groups
@@ -121,10 +149,6 @@ compute.aggte <- function(MP,
   MP$DIDparams$cband <- cband
   dp <- MP$DIDparams
 
-  if (!(type %in% c("simple", "dynamic", "group", "calendar"))) {
-    stop('`type` must be one of c("simple", "dynamic", "group", "calendar")')
-  }
-
   if (na.rm) {
     notna <- !is.na(att)
     if (!any(notna)) {

R/conditional_did_pretest.R

@@ -66,6 +66,8 @@ conditional_did_pretest <- function(yname,
 
   message("We are no longer updating this function.  It should continue to work, but most users find the pre-tests already reported by the `att_gt` function to be sufficient for most empirical applications.")
 
+  if (missing(control_group)) control_group <- "nevertreated"
+
   # this is a DIDparams object
   dp <- pre_process_did(yname=yname,
                         tname=tname,
@@ -364,16 +366,33 @@ indicator <- function(X, u) {
 #'
 #' @export
 test.mboot <- function(inf.func, DIDparams, cores=1) {
+  validate_positive_whole_number(cores, "cores")
+  if (!is.numeric(inf.func) || length(dim(inf.func)) != 3L ||
+      any(dim(inf.func) <= 0L)) {
+    stop("inf.func must be a numeric three-dimensional array with positive dimensions.")
+  }
+  if (!is.list(DIDparams)) {
+    stop("DIDparams must be a list or DIDparams object.")
+  }
 
   # setup needed variables
   data <- DIDparams$data
   idname <- DIDparams$idname
   clustervars <- DIDparams$clustervars
   biters <- DIDparams$biters
   tname <- DIDparams$tname
+  if (!is.data.frame(data)) {
+    stop("DIDparams$data must be a data.frame.")
+  }
+  validate_column_name(idname, "DIDparams$idname", names(data))
+  validate_column_name(tname, "DIDparams$tname", names(data))
+  validate_column_names(clustervars, "DIDparams$clustervars", names(data), allow_null = TRUE)
   tlist <- unique(data[,tname])[order(unique(data[,tname]))]
   alp <- DIDparams$alp
   panel <- DIDparams$panel
+  validate_positive_whole_number(biters, "biters")
+  validate_alp(alp)
+  validate_logical_scalar(panel, "DIDparams$panel")
 
   # just get n obsevations (for clustering below...)
   if (panel) {
@@ -382,6 +401,9 @@ test.mboot <- function(inf.func, DIDparams, cores=1) {
     dta <- data
   }
   n <- nrow(dta)
+  if (dim(inf.func)[1] != n) {
+    stop("inf.func first dimension must match the number of bootstrap observations.")
+  }
 
   # if include id as variable to cluster on
   # drop it as we do this automatically

R/ggdid.R

@@ -76,11 +76,12 @@ ggdid.MP <- function(object,
                      legend=TRUE,
                      group=NULL,
                      ref_line = 0,
-                     theming = TRUE,
-                     grtitle = "Group",
-                     ...) {
-
-  mpobj <- object
+                     theming = TRUE,
+                     grtitle = "Group",
+                     ...) {
+  validate_positive_whole_number(ncol, "ncol")
+
+  mpobj <- object
 
   G <- length(unique(mpobj$group))
   Y <- length(unique(mpobj$t))## drop 1 period bc DID

R/gplot.R

@@ -10,11 +10,16 @@
 #'
 #' @keywords internal
 #'
-#' @export
-gplot <- function(ssresults, ylim=NULL, xlab=NULL, ylab=NULL, title="Group", xgap=1,
-                  legend=TRUE, ref_line = 0, theming = TRUE) {
-  unique_years <- sort(unique(as.numeric(as.character(ssresults$year))))
-  xgap_int <- max(1L, as.integer(round(xgap)))
+#' @export
+gplot <- function(ssresults, ylim=NULL, xlab=NULL, ylab=NULL, title="Group", xgap=1,
+                  legend=TRUE, ref_line = 0, theming = TRUE) {
+  validate_positive_numeric_scalar(xgap, "xgap")
+  validate_logical_scalar(legend, "legend")
+  validate_logical_scalar(theming, "theming")
+  validate_optional_numeric_scalar(ref_line, "ref_line")
+
+  unique_years <- sort(unique(as.numeric(as.character(ssresults$year))))
+  xgap_int <- max(1L, as.integer(round(xgap)))
   dabreaks <- unique_years[seq(1, length(unique_years), by = xgap_int)]
 
   c.point <-  qnorm(1 - ssresults$alp/2)
@@ -64,10 +69,13 @@ gplot <- function(ssresults, ylim=NULL, xlab=NULL, ylab=NULL, title="Group", xga
 #' @keywords internal
 #'
 #' @export
-splot <- function(ssresults, ylim=NULL, xlab=NULL, ylab=NULL, title="Group",
-                  legend=TRUE, ref_line = 0, theming = TRUE) {
-
-  # names of variables are "weird" for this function because this code builds
+splot <- function(ssresults, ylim=NULL, xlab=NULL, ylab=NULL, title="Group",
+                  legend=TRUE, ref_line = 0, theming = TRUE) {
+  validate_logical_scalar(legend, "legend")
+  validate_logical_scalar(theming, "theming")
+  validate_optional_numeric_scalar(ref_line, "ref_line")
+
+  # names of variables are "weird" for this function because this code builds
   # on the same infrastructure as for plotting group-time average treatment
   # effects and aggregations using event time or calendar time
 

R/honest_did/honest_did.R

@@ -46,7 +46,17 @@ honest_did.AGGTEobj <- function(object,
                                 ...) {
 
 
-  type <- type[1]
+  if (missing(type)) type <- "smoothness"
+  validate_choice_scalar(
+    type,
+    "type",
+    c("smoothness", "relative_magnitude"),
+    'type must be either "smoothness" or "relative_magnitude".'
+  )
+  validate_numeric_scalar(e_time, "e_time")
+  validate_alp(alpha, "alpha")
+  validate_logical_scalar(parallel, "parallel")
+  validate_positive_whole_number(gridPoints, "gridPoints")
 
   # make sure that user is passing in an event study
   if (object$type != "dynamic") {

R/mboot.R

@@ -23,6 +23,9 @@
 #'
 #' @export
 mboot <- function(inf.func, DIDparams, pl = FALSE, cores = 1, return_V = TRUE) {
+  validate_logical_scalar(pl, "pl")
+  validate_positive_whole_number(cores, "cores")
+  validate_logical_scalar(return_V, "return_V")
 
   # setup needed variables according to faster_mode; This returns different type of objects
   # depending on whether we are in faster_mode or not that has to be handled in the code below
@@ -32,6 +35,9 @@ mboot <- function(inf.func, DIDparams, pl = FALSE, cores = 1, return_V = TRUE) {
   tname <- DIDparams$tname
   alp <- DIDparams$alp
   panel <- DIDparams$panel
+  validate_positive_whole_number(biters, "biters")
+  validate_alp(alp)
+  validate_logical_scalar(panel, "DIDparams$panel")
   true_repeated_cross_sections <- DIDparams$true_repeated_cross_sections
   unbalanced_panel <- DIDparams$allow_unbalanced_panel
   # Reuse the per-unit cluster vector that att_gt() stored in DIDparams when it
@@ -58,17 +64,21 @@ mboot <- function(inf.func, DIDparams, pl = FALSE, cores = 1, return_V = TRUE) {
         dta <- data
       }
     }
+    validate_column_names(clustervars, "clustervars", names(dta), allow_null = TRUE)
   }
 
   # Convert sparse matrix to dense for bootstrap computation
   inf.func <- as.matrix(inf.func)
+  if (!is.numeric(inf.func) || nrow(inf.func) < 1L || ncol(inf.func) < 1L) {
+    stop("inf.func must be a numeric matrix with at least one row and one column.")
+  }
 
   # set correct number of units
   n <- nrow(inf.func)
 
   # if include id as variable to cluster on
   # drop it as we do this automatically
-  if (idname %in% clustervars) {
+  if (!is.null(idname) && idname %in% clustervars) {
     clustervars <- clustervars[-which(clustervars==idname)]
   }
 
@@ -114,6 +124,9 @@ mboot <- function(inf.func, DIDparams, pl = FALSE, cores = 1, return_V = TRUE) {
       n_clusters <- length(unique(dta[,clustervars]))
       cluster <- unique(dta[,c(idname,clustervars)])[,2]
     }
+    if (length(cluster) != n) {
+      stop("cluster vector length must match the number of influence-function rows.")
+    }
     cluster_sum_if <- rowsum(inf.func, cluster, reorder=TRUE)
     bres <- sqrt(n_clusters) * run_multiplier_bootstrap(cluster_sum_if, biters, pl, cores)
   }
@@ -179,6 +192,10 @@ mboot <- function(inf.func, DIDparams, pl = FALSE, cores = 1, return_V = TRUE) {
 }
 
 run_multiplier_bootstrap <- function(inf.func, biters, pl = FALSE, cores = 1) {
+  validate_positive_whole_number(biters, "biters")
+  validate_logical_scalar(pl, "pl")
+  validate_positive_whole_number(cores, "cores")
+
   # Split biters into per-core chunks that are always non-negative and sum to
   # biters. The previous rep(ceiling(biters/cores), cores) + correction made
   # chunks[1] negative when biters < cores (e.g. biters=2, cores=4 -> [-1,1,1,1]),