Improve verify_data function

DESCRIPTION

@@ -46,4 +46,4 @@ Config/testthat/edition: 3
 Copyright: 'ggmice' authors
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1

R/ggmice.R

@@ -23,7 +23,7 @@
 ggmice <- function(data = NULL,
                    mapping = ggplot2::aes()) {
   # validate inputs
-  verify_data(data, df = TRUE, imp = TRUE)
+  verify_data(data, classes = c("data.frame", "mids"))
   if (is.null(mapping$x) && is.null(mapping$y)) {
     cli::cli_abort(
       c(
@@ -107,8 +107,8 @@
           .imp = 0,
           .id = rownames(data$data),
           data$data
         )[!miss_xy,],
         data.frame(.where = "imputed", mice::complete(data, action = "long"))[where_xy,]
       ),
       .where = factor(
         .where,
@@ -133,7 +133,7 @@
 
   # edit plot to display missing values on the axes
   if (is.data.frame(data) &&
       !is.null(mapping$x) && !is.null(mapping$y)) {
     gg <- gg +
       ggplot2::coord_cartesian(clip = "off")
     if (!is.null(mapping$x)) {
@@ -187,14 +187,14 @@
     mapping_out <- mapping_text
   }
   if ((mice::is.mids(data) &&
        mapping_text %in% c(".id", ".imp", ".where"))) {
     mapping_out <- NULL
   }
   if (!is.null(mapping_in) &&
       mapping_text %nin% c(vrbs, ".id", ".imp", ".where")) {
     mapping_out <- vrbs[stringr::str_detect(mapping_text, vrbs)]
     if (identical(mapping_out, character(0)) ||
         inherits(try(dplyr::mutate(mapping_data,
                                    !!rlang::parse_quo(mapping_text, env = rlang::current_env())),
                      silent = TRUE)
                  ,

R/plot_corr.R

@@ -24,17 +24,12 @@
     if (is.matrix(data) && ncol(data) > 1) {
       data <- as.data.frame(data)
     }
-    verify_data(data = data, df = TRUE)
+    verify_data(data = data, classes = "data.frame")
     vrb <- substitute(vrb)
-    if (vrb != "all" && length(vrb) < 2) {
+    vrb <- vrb_to_cols(vrb, data)
+    if (length(vrb) < 2) {
       cli::cli_abort("The number of variables should be two or more to compute correlations.")
     }
-    if (vrb[1] == "all") {
-      vrb <- names(data)
-    } else {
-      data <- dplyr::select(data, {{vrb}})
-      vrb <- names(data)
-    }
     # check if any column is constant
     constants <- apply(data, MARGIN = 2, function(x) {
       all(is.na(x)) || max(x, na.rm = TRUE) == min(x, na.rm = TRUE)
@@ -91,7 +86,7 @@
           y = "Variable to impute",
           fill = "Correlation*
       ",
       caption = "*pairwise complete observations"
         )
     } else {
       gg <- gg +

R/plot_flux.R

@@ -15,16 +15,12 @@ plot_flux <-
            vrb = "all",
            label = TRUE,
            caption = TRUE) {
-    verify_data(data, df = TRUE)
+    verify_data(data, classes = "data.frame")
     vrb <- substitute(vrb)
-    if (vrb != "all" && length(vrb) < 2) {
+    vrb <- vrb_to_cols(vrb, data)
+    if (length(vrb) < 2) {
       cli::cli_abort("The number of variables should be two or more to compute flux.")
     }
-    if (vrb[1] == "all") {
-      vrb <- names(data)
-    } else {
-      vrb <- names(dplyr::select(data, {{vrb}}))
-    }
     # plot in and outflux
     flx <- mice::flux(data[, vrb])[, c("influx", "outflux")]
     gg <-

R/plot_pattern.R

@@ -25,16 +25,12 @@ plot_pattern <-
     if (is.matrix(data) && ncol(data) > 1) {
       data <- as.data.frame(data)
     }
-    verify_data(data, df = TRUE)
+    verify_data(data, classes = "data.frame")
     vrb <- substitute(vrb)
-    if (vrb != "all" && length(vrb) < 2) {
+    vrb <- vrb_to_cols(vrb, data)
+    if (length(vrb) < 2) {
       cli::cli_abort("The number of variables should be two or more to compute missing data patterns.")
     }
-    if (vrb[1] == "all") {
-      vrb <- names(data)
-    } else {
-      vrb <- names(dplyr::select(as.data.frame(data), {{vrb}}))
-    }
     if (".x" %in% vrb || ".y" %in% vrb) {
       cli::cli_abort(
         c(

R/plot_pred.R

@@ -20,7 +20,7 @@ plot_pred <-
            label = TRUE,
            square = TRUE,
            rotate = FALSE) {
-    verify_data(data, pred = TRUE)
+    verify_data(data, classes = "matrix")
     p <- nrow(data)
     if (!is.null(method) && is.character(method)) {
       if (length(method) == 1) {
@@ -38,11 +38,7 @@ plot_pred <-
       cli::cli_abort("Method should be NULL or a character string or vector (of length 1 or `ncol(data)`).")
     }
     vrb <- substitute(vrb)
-    if (vrb[1] == "all") {
-      vrb <- names(data)
-    } else {
-      vrb <- names(dplyr::select(as.data.frame(data), {{vrb}}))
-    }
+    vrb <- vrb_to_cols(vrb, data)
     vrbs <- row.names(data)
     long <- data.frame(
       vrb = 1:p,

R/plot_trace.R

@@ -10,7 +10,7 @@
 #' plot_trace(imp)
 #' @export
 plot_trace <- function(data, vrb = "all") {
-  verify_data(data, imp = TRUE)
+  verify_data(data, classes = "mids")
   if (is.null(data$chainMean) && is.null(data$chainVar)) {
     cli::cli_abort("No convergence diagnostics found", call. = FALSE)
   }
@@ -20,9 +20,9 @@ plot_trace <- function(data, vrb = "all") {
   sm <- sqrt(data$chainVar)
 
   # select variable to plot from list of imputed variables
-  vrb <- substitute(vrb)
   varlist <-
     names(data$imp)[apply(!(is.nan(mn) | is.na(mn)), 1, all)]
+  vrb <- substitute(vrb)
   if (as.character(vrb)[1] == "all") {
     vrb <- varlist
   } else {

R/utils.R

@@ -22,82 +22,42 @@
 #' Utils function to validate data argument inputs
 #'
 #' @param data The input supplied to the 'data' argument.
-#' @param df Logical indicating whether 'data.frame' inputs are permitted.
-#' @param imp Logical indicating whether 'mids' inputs are permitted.
-#' @param pred Logical indicating whether predictor matrix inputs are permitted.
+#' @param classes String or character vector specifying which of the data types `data.frame`, `mids`, and/or `matrix` are allowed.
 #'
 #' @return Either nothing or an error.
 #'
 #' @keywords internal
 #' @noRd
 verify_data <- function(data,
-                        df = FALSE,
-                        imp = FALSE,
-                        pred = FALSE) {
-  if (df && !imp) {
-    if (!(is.data.frame(data) || is.matrix(data))) {
-      cli::cli_abort(
-        c(
-          "The 'data' argument requires an object of class 'data.frame' or 'matrix'.",
-          "i" = "Input object is of class {class(data)}."
-        ),
-        call. = FALSE
-      )
-    }
+                        classes) {
+  if(!rlang::inherits_any(data, classes)){
+    classes_format <- purrr::map(classes, function(x) paste0("`", x, "`")) %>% unlist() # format type names to be used in function
+    cli::cli_abort(c(
+      "!" = "The {.arg data} argument requires an object of class {stringr::str_flatten_comma({classes_format}, \", or \")}.",
+      "i" = "Input object is of class `{class(data)}`"
+    ),
+    call. = FALSE)
   }
-  if (df && imp) {
-    if (!(is.data.frame(data) ||
-          is.matrix(data) || mice::is.mids(data))) {
-      cli::cli_abort(
-        c(
-          "The 'data' argument requires an object of class 'data.frame', 'matrix', or 'mids'.",
-          "i" = "Input object is of class {class(data)}."
-        ),
-        call. = FALSE
-      )
-    }
-  }
-  if (imp && !df) {
-    if (!mice::is.mids(data)) {
-      cli::cli_abort(
-        c(
-          "The 'data' argument requires an object of class 'mids'.",
-          "i" = "Input object is of class {class(data)}."
-        ),
-        call. = FALSE
-      )
-    }
-  }
-  if (pred) {
-    if (!is.matrix(data)) {
-      cli::cli_abort(
-        c(
-          "The 'data' argument requires an object of class 'matrix'.",
-          "i" = "Input object is of class {class(data)}."
-        ),
-        call. = FALSE
-      )
-    }
-    if (dim(data)[1] != dim(data)[2]) {
-      cli::cli_abort(
-        c(
-          "The 'data' argument requires a square predictor matrix.",
-          "i" = "Input object has {dim(data)[1]} rows and {dim(data)[2]} columns."
-        ),
-        call. = FALSE
-      )
-    }
-    if (is.null(rownames(data)) || is.null(colnames(data)) ||
-        !all.equal(rownames(data), colnames(data))) {
-      cli::cli_warn(
-        c(
-          "The 'data' argument expects a square predictor matrix with equal row and column names.",
-          "i" = "Try using `mice::make.predictorMatrix()` or `mice::quickpred()`."
-        ),
-        call. = FALSE
-      )
-    }
+}
+
+#' Utils function to process variable vector as character vector
+#'
+#' @param vrb The input supplied to the `vrb` argument.
+#' @param data The input supplied to the `data` argument.
+#'
+#' @return String with variable names
+#'
+#' @keywords internal
+#' @noRd
+vrb_to_cols <- function(vrb, data){
+  if (vrb[1] == "all") {
+    vrb <- colnames(data)
+  } else {
+    vrb <- as.data.frame(data) %>%
+      dplyr::select({{vrb}}) %>%
+      colnames()
   }
+  return(vrb)
 }
 
 # suppress undefined global functions or variables note