edit verify_data. add vrb_to_cols

Edit preprocessing function for checking data. Add (and implement) preprocessing function for extracting variable names.

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(

R/plot_corr.R

@@ -24,17 +24,12 @@ plot_corr <-
     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)

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,50 +22,42 @@ NULL
 #' 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) {
-  df <- data.frame(val = unlist(as.list(environment())[-1]),
-                   type = c("data.frame", "mids", "matrix"))
-  types <- df[df$val==T,]$type
-  types_format <- purrr::map(types, function(x) paste0("`", x, "`")) %>% unlist()
-  if(!inherits(data, types)){
+                        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({types_format}, \", or \")}.",
-      "i" = "Input object is of class {class(data)}"
+      "!" = "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 (is.matrix(data)) {
-    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