Minimal argument checking review (#561)

Standardize argument checking with `rlang::arg_match0()` + use inherits instead of class(x) %in%

R/adorn_ns.R

@@ -61,9 +61,9 @@ adorn_ns <- function(dat, position = "rear", ns = attr(dat, "core"), format_func
     if (!is.data.frame(dat)) {
       stop("adorn_ns() must be called on a data.frame or list of data.frames")
     }
-    if (!position %in% c("rear", "front")) {
-      stop("\"position\" must be one of \"front\" or \"rear\"")
-    }
+
+    rlang::arg_match0(position, c("front", "rear"))
+
     if (is.null(ns)) {
       stop("argument \"ns\" cannot be null; if not calling adorn_ns() on a data.frame of class \"tabyl\", pass your own value for ns")
     }

R/adorn_pct_formatting.R

@@ -58,9 +58,8 @@ adorn_pct_formatting <- function(dat, digits = 1, rounding = "half to even", aff
     if (!is.data.frame(dat)) {
       stop("adorn_pct_formatting() must be called on a data.frame or list of data.frames")
     }
-    if (!rounding %in% c("half to even", "half up")) {
-      stop("'rounding' must be one of 'half to even' or 'half up'")
-    }
+    rlang::arg_match0(rounding, c("half to even", "half up"))
+
     original <- dat # used below to record original instances of NA and NaN
 
     numeric_cols <- which(vapply(dat, is.numeric, logical(1)))

R/adorn_percentages.R

@@ -43,9 +43,7 @@ adorn_percentages <- function(dat, denominator = "row", na.rm = TRUE, ...) {
     if (!is.data.frame(dat)) {
       stop("adorn_percentages() must be called on a data.frame or list of data.frames")
     }
-    if (!denominator %in% c("row", "col", "all")) {
-      stop("'denominator' must be one of 'row', 'col', or 'all'")
-    }
+    rlang::arg_match0(denominator, c("row", "col", "all"))
 
     dat <- as_tabyl(dat)
 

R/adorn_title.R

@@ -33,16 +33,16 @@ adorn_title <- function(dat, placement = "top", row_name, col_name) {
     if (!is.data.frame(dat)) {
       stop("\"dat\" must be a data.frame")
     }
-    if (!placement %in% c("top", "combined")) {
-      stop("\"placement\" must be one of \"top\" or \"combined\"")
-    }
-    if ("tabyl" %in% class(dat)) {
+
+    rlang::arg_match0(placement, c("top", "combined"))
+
+    if (inherits(dat, "tabyl")) {
       if (attr(dat, "tabyl_type") == "one_way") {
         warning("adorn_title is meant for two-way tabyls, calling it on a one-way tabyl may not yield a meaningful result")
       }
     }
     if (missing(col_name)) {
-      if (!"tabyl" %in% class(dat)) {
+      if (!inherits(dat, "tabyl")) {
         stop("When input is not a data.frame of class tabyl, a value must be specified for the col_name argument")
       }
       col_var <- attr(dat, "var_names")$col
@@ -60,7 +60,7 @@ adorn_title <- function(dat, placement = "top", row_name, col_name) {
       names(dat)[1] <- row_name
       row_var <- row_name
     } else {
-      if ("tabyl" %in% class(dat)) {
+      if (inherits(dat, "tabyl")) {
         row_var <- attr(dat, "var_names")$row
       } else {
         row_var <- names(dat)[1] # for non-tabyl input, if no row_name supplied, use first existing name
@@ -82,7 +82,7 @@ adorn_title <- function(dat, placement = "top", row_name, col_name) {
       out <- dat
       names(out)[1] <- paste(row_var, col_var, sep = "/")
     }
-    if ("tbl_df" %in% class(out)) { # "top" text doesn't print if input (and thus the output) is a tibble
+    if (inherits(out, "tbl_df")) { # "top" text doesn't print if input (and thus the output) is a tibble
       out <- as.data.frame(out) # but this prints row numbers, so don't apply to non-tbl_dfs like tabyls
     }
     out

R/adorn_totals.R

@@ -54,7 +54,7 @@ adorn_totals <- function(dat, where = "row", fill = "-", na.rm = TRUE, name = "T
 
 
     # grouped_df causes problems, #97
-    if ("grouped_df" %in% class(dat)) {
+    if (inherits(dat, "grouped_df")) {
       dat <- dplyr::ungroup(dat)
     }
 

R/as_and_untabyl.R

@@ -52,7 +52,7 @@ as_tabyl <- function(dat, axes = 2, row_var_name = NULL, col_var_name = NULL) {
   }
 
   # assign core attribute and classes
-  if ("tabyl" %in% class(dat)) {
+  if (inherits(dat, "tabyl")) {
     # if already a tabyl, may have totals row.  Safest play is to simply reorder the core rows to match the dat rows
     attr(dat, "core") <- attr(dat, "core")[order(match(
       attr(dat, "core")[, 1],
@@ -101,7 +101,7 @@ untabyl <- function(dat) {
   if (is.list(dat) && !is.data.frame(dat)) {
     purrr::map(dat, untabyl)
   } else {
-    if (!"tabyl" %in% class(dat)) {
+    if (!inherits(dat, "tabyl")) {
       warning("untabyl() called on a non-tabyl")
     }
     class(dat) <- class(dat)[!class(dat) %in% "tabyl"]

R/tabyl.R

@@ -247,7 +247,7 @@ tabyl_3way <- function(dat, var1, var2, var3, show_na = TRUE, show_missing_level
   # grab class of 1st variable to restore it later
   col1_class <- class(dat[[1]])
   col1_levels <- NULL
-  if ("factor" %in% col1_class) {
+  if (is.factor(dat[[1]])) {
     col1_levels <- levels(dat[[1]])
   }
 

tests/testthat/test-adorn-ns.R

@@ -46,9 +46,9 @@ test_that("bad inputs are caught", {
     "argument \"ns\" cannot be null; if not calling adorn_ns() on a data.frame of class \"tabyl\", pass your own value for ns",
     fixed = TRUE
   )
-  expect_error(mtcars %>% tabyl(am, cyl) %>% adorn_ns("huh"),
-    "\"position\" must be one of \"front\" or \"rear\"",
-    fixed = TRUE
+  expect_error(
+    mtcars %>% tabyl(am, cyl) %>% adorn_ns("huh"),
+    "`position` must be one of \"front\" or \"rear\", not \"huh\""
   )
   expect_error(
     mtcars %>% tabyl(am, cyl) %>% adorn_ns(ns = mtcars$mpg),

tests/testthat/test-adorn-pct-formatting.R

@@ -126,7 +126,7 @@ test_that("bad rounding argument caught", {
     dat %>%
       adorn_percentages() %>%
       adorn_pct_formatting(rounding = "blargh"),
-    "'rounding' must be one of 'half to even' or 'half up'",
+    "`rounding` must be one of \"half to even\" or \"half up\", not \"blargh\".",
     fixed = TRUE
   )
 })

tests/testthat/test-adorn-percentages.R

@@ -5,7 +5,7 @@ test_that("bad input to denominator arg is caught", {
   expect_error(
     mtcars %>%
       adorn_percentages("blargh"),
-    paste0("'denominator' must be one of 'row', 'col', or 'all'"),
+    "`denominator` must be one of \"row\", \"col\", or \"all\"",
     fixed = TRUE
   )
 })

tests/testthat/test-adorn-title.R

@@ -65,7 +65,7 @@ test_that("bad inputs are caught", {
     adorn_title(source1,
       placement = "blargh"
     ),
-    "\"placement\" must be one of \"top\" or \"combined\"",
+    "`placement` must be one of \"top\" or \"combined\"",
     fixed = TRUE
   )
   expect_error(