From c044118bd09b9a4095bab86725bd05c45921a7cc Mon Sep 17 00:00:00 2001 From: olivroy Date: Sun, 10 Sep 2023 11:23:29 -0400 Subject: [PATCH] Standardize argument checking with `rlang::arg_match0()` + use inherits instead of class(x) %in% --- R/adorn_ns.R | 6 +++--- R/adorn_pct_formatting.R | 5 ++--- R/adorn_percentages.R | 4 +--- R/adorn_title.R | 14 +++++++------- R/adorn_totals.R | 2 +- R/as_and_untabyl.R | 4 ++-- R/tabyl.R | 2 +- tests/testthat/test-adorn-ns.R | 6 +++--- tests/testthat/test-adorn-pct-formatting.R | 2 +- tests/testthat/test-adorn-percentages.R | 2 +- tests/testthat/test-adorn-title.R | 2 +- 11 files changed, 23 insertions(+), 26 deletions(-) diff --git a/R/adorn_ns.R b/R/adorn_ns.R index 97bac414..aa80861d 100644 --- a/R/adorn_ns.R +++ b/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") } diff --git a/R/adorn_pct_formatting.R b/R/adorn_pct_formatting.R index 80ac8ed8..100e75b8 100644 --- a/R/adorn_pct_formatting.R +++ b/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))) diff --git a/R/adorn_percentages.R b/R/adorn_percentages.R index 2d7a436a..df3b19f1 100644 --- a/R/adorn_percentages.R +++ b/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) diff --git a/R/adorn_title.R b/R/adorn_title.R index 15783d44..709910eb 100644 --- a/R/adorn_title.R +++ b/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 diff --git a/R/adorn_totals.R b/R/adorn_totals.R index f3aa4e43..8da16c58 100644 --- a/R/adorn_totals.R +++ b/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) } diff --git a/R/as_and_untabyl.R b/R/as_and_untabyl.R index 5a14b525..d42f486d 100644 --- a/R/as_and_untabyl.R +++ b/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"] diff --git a/R/tabyl.R b/R/tabyl.R index 00af7342..369c49a3 100644 --- a/R/tabyl.R +++ b/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]]) } diff --git a/tests/testthat/test-adorn-ns.R b/tests/testthat/test-adorn-ns.R index 26fc0dd2..ebc28770 100644 --- a/tests/testthat/test-adorn-ns.R +++ b/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), diff --git a/tests/testthat/test-adorn-pct-formatting.R b/tests/testthat/test-adorn-pct-formatting.R index dc1731e1..2bc461c9 100644 --- a/tests/testthat/test-adorn-pct-formatting.R +++ b/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 ) }) diff --git a/tests/testthat/test-adorn-percentages.R b/tests/testthat/test-adorn-percentages.R index ebd3fa97..6e3caf0e 100644 --- a/tests/testthat/test-adorn-percentages.R +++ b/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 ) }) diff --git a/tests/testthat/test-adorn-title.R b/tests/testthat/test-adorn-title.R index d0e2d3ec..6dab98bb 100644 --- a/tests/testthat/test-adorn-title.R +++ b/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(