misc changes

DESCRIPTION

@@ -69,7 +69,7 @@ Imports:
     magrittr,
     stats,
     visdat,
-    rlang,
+    rlang (>= 1.1.0),
     forcats,
     viridis,
     glue,
@@ -139,6 +139,6 @@ URL: https://github.com/njtierney/naniar,
 BugReports: https://github.com/njtierney/naniar/issues
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0
 Language: en-US
 Config/testthat/edition: 3

R/add-cols.R

@@ -21,7 +21,7 @@
 add_shadow <- function(data, ...){
 
   test_if_dots_missing(
-    ...,
+    missing(...),
     "{.fun add_shadow} requires variables to be selected"
     )
   shadow_df <- dplyr::select(data, ...) %>% as_shadow()

R/naniar-package.R

@@ -8,6 +8,7 @@
 #' @name naniar
 #' @docType package
 #' @seealso [add_any_miss()] [add_label_missings()] [add_label_shadow()] [add_miss_cluster()] [add_n_miss()] [add_prop_miss()] [add_shadow()] [add_shadow_shift()] [as_shadow()] [bind_shadow()] [cast_shadow()] [cast_shadow_shift()] [cast_shadow_shift_label()] [draw_key_missing_point()] [gather_shadow()] [geom_miss_point()] [gg_miss_case()] [gg_miss_case_cumsum()] [gg_miss_fct()] [gg_miss_span()] [gg_miss_var()] [gg_miss_var_cumsum()] [gg_miss_which()] [label_miss_1d()] [label_miss_2d()] [label_missings()] [pct_miss_case()] [prop_miss_case()] [pct_miss_var()] [prop_miss_var()] [pct_complete_case()] [prop_complete_case()] [pct_complete_var()] [prop_complete_var()] [miss_prop_summary()] [miss_case_summary()] [miss_case_table()] [miss_summary()] [miss_var_prop()] [miss_var_run()] [miss_var_span()] [miss_var_summary()] [miss_var_table()] [n_complete()] [n_complete_row()] [n_miss()] [n_miss_row()] [pct_complete()] [pct_miss()] [prop_complete()] [prop_complete_row()] [prop_miss()] [prop_miss_row()] [replace_to_na()] [replace_with_na()] [replace_with_na_all()] [replace_with_na_at()] [replace_with_na_if()] [shadow_shift()] [stat_miss_point()] [vis_miss()] [where_na()]
+"_PACKAGE"
 
 #' @import ggplot2
 #' @import rlang

R/utils.R

@@ -22,17 +22,16 @@ rlang::are_na
 #' @keywords internal
 #' @noRd
 #' @examples
-#'
 #' \dontrun{
-#' miss_case_table.grouped_df <- function(data){
-#' group_by_fun(data,.fun = miss_case_table)
+#' miss_case_table.grouped_df <- function(data) {
+#'   group_by_fun(data, .fun = miss_case_table)
 #' }
 #' airquality %>%
-#' group_by(Month) %>%
-#' miss_case_table()
+#'   group_by(Month) %>%
+#'   miss_case_table()
 #' }
 #'
-group_by_fun <- function(data,.fun, ...){
+group_by_fun <- function(data, .fun, ...) {
   tidyr::nest(data) %>%
     dplyr::mutate(data = purrr::map(data, .fun, ...)) %>%
     tidyr::unnest(cols = c(data))
@@ -49,14 +48,13 @@ group_by_fun <- function(data,.fun, ...){
 #' \dontrun{
 #' # success
 #' test_if_null(airquality)
-#' #fail
+#' # fail
 #' my_test <- NULL
 #' test_if_null(my_test)
 #' }
 #' @keywords internal
 #' @noRd
-test_if_null <- function(x){
-
+test_if_null <- function(x) {
   # test for null
   if (is.null(x)) {
     cli::cli_abort(
@@ -79,13 +77,12 @@ test_if_null <- function(x){
 #' # success
 #' my_test <- x
 #' test_if_null(my_test)
-#' #fail
+#' # fail
 #' test_if_missing()
 #' }
 #' @keywords internal
 #' @noRd
-test_if_missing <- function(x, msg = NULL){
-
+test_if_missing <- function(x, msg = NULL) {
   # test for null
   if (missing(x)) {
     cli::cli_abort(
@@ -94,20 +91,22 @@ test_if_missing <- function(x, msg = NULL){
         "{msg}"
       )
     )
-      }
   }
+}
 
 #' @keywords internal
 #' @noRd
-test_if_dots_missing <- function(..., msg = NULL){
-
+test_if_dots_missing <- function(dots_empty,
+                                 msg = NULL,
+                                 call = rlang::caller_env()) {
   # test for null
-  if (missing(...)) {
+  if (dots_empty) {
     cli::cli_abort(
       c(
         "argument must be specified",
         "{msg}"
-      )
+      ),
+      call = call
     )
   }
 }
@@ -122,14 +121,14 @@ test_if_dots_missing <- function(..., msg = NULL){
 #' \dontrun{
 #' # success
 #' test_if_dataframe(airquality)
-#' #fail
+#' # fail
 #' my_test <- matrix(10)
 #' test_if_dataframe(my_test)
 #' }
 #'
 #' @keywords internal
 #' @noRd
-test_if_dataframe <- function(x){
+test_if_dataframe <- function(x) {
   # test for dataframe
   if (!inherits(x, "data.frame")) {
     cli::cli_abort(
@@ -141,7 +140,7 @@ test_if_dataframe <- function(x){
   }
 }
 
-test_if_any_shade <- function(x){
+test_if_any_shade <- function(x) {
   # test for dataframe
   test_if_dataframe(x)
   if (!any_shade(x)) {
@@ -160,7 +159,7 @@ test_if_any_shade <- function(x){
 #'
 #' @return logical vector TRUE = missing FALSE = complete
 #'
-any_row_miss <- function(x){
+any_row_miss <- function(x) {
   apply(data.frame(x), MARGIN = 1, FUN = function(x) anyNA(x))
 }
 
@@ -179,11 +178,13 @@ any_row_miss <- function(x){
 #' # add_span_counter(pedestrian, span_size = 100)
 #' }
 add_span_counter <- function(data, span_size) {
-
   dplyr::mutate(data,
-                span_counter = rep(x = 1:ceiling(nrow(data)),
-                                   each = span_size,
-                                   length.out = nrow(data)))
+    span_counter = rep(
+      x = 1:ceiling(nrow(data)),
+      each = span_size,
+      length.out = nrow(data)
+    )
+  )
 }
 
 #' check the levels of many things
@@ -197,8 +198,7 @@ add_span_counter <- function(data, span_size) {
 #' @noRd
 what_levels <- function(x) purrr::map(x, levels)
 
-quo_to_shade <- function(...){
-
+quo_to_shade <- function(...) {
   # Use ensyms() rather than quos() because the latter allows
   # arbitrary expressions. These variables are forwarded to select(),
   # so potential expressions are `starts_with()`, `one_of()`, etc.
@@ -213,25 +213,27 @@ quo_to_shade <- function(...){
   shadow_vars <- rlang::syms(shadow_chr)
 
   return(shadow_vars)
-
 }
 
-class_glue <- function(x){
+class_glue <- function(x) {
   class(x) %>% glue::glue_collapse(sep = ", ", last = ", or ")
 }
 
-diag_na <- function(size = 5){
-
-  dna <- diag(x = NA,
-              nrow = size,
-              ncol = size)
+diag_na <- function(size = 5) {
+  dna <- diag(
+    x = NA,
+    nrow = size,
+    ncol = size
+  )
   suppressMessages(
     tibble::as_tibble(dna,
-                      .name_repair = "unique")) %>%
-    set_names(paste0("x",seq_len(ncol(.))))
+      .name_repair = "unique"
+    )
+  ) %>%
+    set_names(paste0("x", seq_len(ncol(.))))
 }
 
-coerce_fct_na_explicit <- function(x){
+coerce_fct_na_explicit <- function(x) {
   if (is.factor(x) & anyNA(x)) {
     forcats::fct_na_value_to_level(x, level = "NA")
   } else {
@@ -241,15 +243,15 @@ coerce_fct_na_explicit <- function(x){
 
 # any_shade <- function(x) any(grepl("^NA|^NA_", x))
 
-any_row_shade <- function(x){
+any_row_shade <- function(x) {
   apply(data.frame(x), MARGIN = 1, FUN = function(x) any(grepl("^NA|^NA_", x)))
 }
 
 vecIsFALSE <- Vectorize(isFALSE)
 
 are_any_false <- function(x, ...) any(vecIsFALSE(x), ...)
 
-check_btn_0_1 <- function(prop){
+check_btn_0_1 <- function(prop) {
   if (prop < 0 || prop > 1) {
     cli::cli_abort(
       c(
@@ -260,7 +262,7 @@ check_btn_0_1 <- function(prop){
   }
 }
 
-check_is_integer <- function(x){
+check_is_integer <- function(x) {
   if (x < 0) {
     cli::cli_abort(
       c(
@@ -272,7 +274,7 @@ check_is_integer <- function(x){
   vctrs::vec_cast(x, integer())
 }
 
-check_is_scalar <- function(x){
+check_is_scalar <- function(x) {
   if (length(x) != 1) {
     cli::cli_abort(
       c(

tests/testthat/_snaps/add-label-shadow.md

@@ -2,7 +2,8 @@
 
     Code
       add_label_shadow(dat)
-    Error <rlang_error>
-      add_label_shadow works with shadow data, which has columns
+    Condition
+      Error in `add_label_shadow()`:
+      ! add_label_shadow works with shadow data, which has columns
                        created by `shade()`, `as_shadow()`, or `bind_shadow()`
 

tests/testthat/_snaps/add-shadow.new.md

@@ -0,0 +1,9 @@
+# add_shadow returns a nice error message when no variables are provided
+
+    Code
+      add_shadow(dat)
+    Condition
+      Error in `add_shadow()`:
+      ! argument must be specified
+      {.fun add_shadow} requires variables to be selected
+

tests/testthat/_snaps/as-shadow.md

@@ -2,31 +2,35 @@
 
     Code
       as_shadow(0)
-    Error <rlang_error>
-      Input must inherit from <data.frame>
+    Condition
+      Error in `test_if_dataframe()`:
+      ! Input must inherit from <data.frame>
       We see class: <numeric>
 
 ---
 
     Code
       as_shadow("a")
-    Error <rlang_error>
-      Input must inherit from <data.frame>
+    Condition
+      Error in `test_if_dataframe()`:
+      ! Input must inherit from <data.frame>
       We see class: <character>
 
 ---
 
     Code
       as_shadow(matrix(airquality))
-    Error <rlang_error>
-      Input must inherit from <data.frame>
+    Condition
+      Error in `test_if_dataframe()`:
+      ! Input must inherit from <data.frame>
       We see class: <matrix/array>
 
 ---
 
     Code
       as_shadow(NULL)
-    Error <rlang_error>
-      Input must not be NULL
+    Condition
+      Error in `test_if_null()`:
+      ! Input must not be NULL
       Input is <NULL>