Major update that improves support for formulas specification

R/formula.R

@@ -124,7 +124,8 @@ name.formulas <- function(formulas, prefix = "f") {
 }
 
 
-check.formulas <- function(formulas, data) {
+check.formulas <- function(formulas, data,
+                           autoremove = TRUE) {
   formulas <- name.formulas(formulas)
   formulas <- handle.oldstyle.formulas(formulas, data)
   formulas <- lapply(formulas, expand.dots, data)
@@ -143,7 +144,14 @@ check.formulas <- function(formulas, data) {
   completevars <- colnames(data)[!apply(is.na(data), 2, sum)]
   uip <- setdiff(notimputed, completevars)
   # if any of these are in RHS for formulas, remove them
-  formulas <- lapply(formulas, remove.rhs.variables, vars = uip)
+  removeme <- intersect(uip, as.vector(sapply(formulas, all.vars)))
+  if (length(removeme) && autoremove) {
+    formulas <- lapply(formulas, remove.rhs.variables, vars = removeme)
+    vars <- paste(removeme, collapse = ",")
+    updateLog(out = paste("incomplete predictor(s)", vars),
+              meth = "check", frame = 1)
+  }
+
   # add components y ~ 1 for y to formulas
   for (y in notimputed) {
     formulas[[y]] <- as.formula(paste(y, "~ 1"))

R/mice.R

@@ -324,6 +324,8 @@
 #'                  variable group (or block) to which each variable is
 #'                  allocated.
 #' @param blots     Deprecated. Replaced by `dots`.
+#' @param autoremove Logical. Should unimputed incomplete predictors be removed
+#'                  to prevent NA propagation?
 #'
 #' @return Returns an S3 object of class [`mids()`][mids-class]
 #'        (multiply imputed data set)
@@ -413,6 +415,7 @@ mice <- function(data,
                  seed = NA,
                  data.init = NULL,
                  blots = NULL,
+                 autoremove = TRUE,
                  ...) {
   call <- match.call()
 
@@ -424,6 +427,10 @@ mice <- function(data,
     dots <- blots
   }
 
+  # data frame for storing the event log
+  state <- list(it = 0, im = 0, dep = "", meth = "", log = FALSE)
+  loggedEvents <- data.frame(it = 0, im = 0, dep = "", meth = "", out = "")
+
   if (!is.na(seed)) set.seed(seed)
 
   # check form of data and m
@@ -451,7 +458,8 @@ mice <- function(data,
   # case B
   if (!mp & mb & mf) {
     # predictorMatrix leads
-    predictorMatrix <- check.predictorMatrix(predictorMatrix, data)
+    predictorMatrix <- check.predictorMatrix(predictorMatrix, data,
+                                             autoremove = autoremove)
     blocks <- make.blocks(colnames(predictorMatrix), partition = "scatter")
     formulas <- make.formulas(data, blocks, predictorMatrix = predictorMatrix)
   }
@@ -467,15 +475,16 @@ mice <- function(data,
   # case D
   if (mp & mb & !mf) {
     # formulas leads
-    formulas <- check.formulas(formulas, data)
+    formulas <- check.formulas(formulas, data, autoremove = autoremove)
     blocks <- construct.blocks(formulas)
     predictorMatrix <- f2p(formulas, data, blocks)
   }
 
   # case E
   if (!mp & !mb & mf) {
     # predictor leads (use for multivariate imputation)
-    predictorMatrix <- check.predictorMatrix(predictorMatrix, data)
+    predictorMatrix <- check.predictorMatrix(predictorMatrix, data,
+                                             autoremove = autoremove)
     blocks <- check.blocks(blocks, data, calltype = "pred")
     formulas <- make.formulas(data, blocks, predictorMatrix = predictorMatrix)
   }
@@ -571,10 +580,6 @@ mice <- function(data,
   dots <- check.dots(dots, data, blocks)
   ignore <- check.ignore(ignore, data)
 
-  # data frame for storing the event log
-  state <- list(it = 0, im = 0, dep = "", meth = "", log = FALSE)
-  loggedEvents <- data.frame(it = 0, im = 0, dep = "", meth = "", out = "")
-
   # edit imputation setup
   setup <- list(
     method = method,

R/predictorMatrix.R

@@ -45,7 +45,8 @@ make.predictorMatrix <- function(data, blocks = make.blocks(data),
 
 check.predictorMatrix <- function(predictorMatrix,
                                   data,
-                                  blocks = NULL) {
+                                  blocks = NULL,
+                                  autoremove = TRUE) {
   data <- check.dataform(data)
 
   if (!is.matrix(predictorMatrix)) {
@@ -82,9 +83,23 @@ check.predictorMatrix <- function(predictorMatrix,
     )
   }
 
-  # calculate ynames (variables to impute) for use in check.method()
+  # NA-propagation prevention
+  # find all dependent (imputed) variables
   hit <- apply(predictorMatrix, 1, function(x) any(x != 0))
   ynames <- row.names(predictorMatrix)[hit]
+  # find all variables in data that are not imputed
+  notimputed <- setdiff(colnames(data), ynames)
+  # select uip: unimputed incomplete predictors
+  completevars <- colnames(data)[!apply(is.na(data), 2, sum)]
+  uip <- setdiff(notimputed, completevars)
+  # if any of these are predictors, remove them
+  removeme <- intersect(uip, colnames(predictorMatrix))
+  if (length(removeme) && autoremove) {
+    predictorMatrix[, removeme] <- 0
+    vars <- paste(removeme, collapse = ",")
+    updateLog(out = paste("incomplete predictor(s)", vars),
+              meth = "check", frame = 1)
+  }
 
   # grow predictorMatrix to all variables in data
   if (ncol(predictorMatrix) < ncol(data)) {