From 875adf4375e008c9005b160a6b1caa59cd73c40e Mon Sep 17 00:00:00 2001 From: njtierney Date: Mon, 4 Mar 2024 11:15:07 +1100 Subject: [PATCH] misc changes --- DESCRIPTION | 4 +- R/add-cols.R | 2 +- R/naniar-package.R | 1 + R/utils.R | 84 ++++++++++--------- man/naniar.Rd | 20 +++++ tests/testthat/_snaps/add-label-shadow.md | 5 +- tests/testthat/_snaps/add-shadow.new.md | 9 ++ tests/testthat/_snaps/as-shadow.md | 20 +++-- tests/testthat/_snaps/as_shadow_upset.md | 35 ++++---- .../_snaps/replace-with-na-scoped-var.md | 7 +- 10 files changed, 114 insertions(+), 73 deletions(-) create mode 100644 tests/testthat/_snaps/add-shadow.new.md diff --git a/DESCRIPTION b/DESCRIPTION index 58d4fbd2..274d31b3 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/add-cols.R b/R/add-cols.R index 3f144284..b168101d 100644 --- a/R/add-cols.R +++ b/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() diff --git a/R/naniar-package.R b/R/naniar-package.R index 558b3cd1..b94286c1 100644 --- a/R/naniar-package.R +++ b/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 diff --git a/R/utils.R b/R/utils.R index c57de7b1..6100cc14 100644 --- a/R/utils.R +++ b/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,7 +243,7 @@ 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))) } @@ -249,7 +251,7 @@ 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( diff --git a/man/naniar.Rd b/man/naniar.Rd index c3b7658a..329c5f88 100644 --- a/man/naniar.Rd +++ b/man/naniar.Rd @@ -2,6 +2,7 @@ % Please edit documentation in R/naniar-package.R \docType{package} \name{naniar} +\alias{naniar-package} \alias{naniar} \title{naniar} \description{ @@ -13,3 +14,22 @@ principles as possible. The work is fully discussed at Tierney & Cook (2023) \seealso{ \code{\link[=add_any_miss]{add_any_miss()}} \code{\link[=add_label_missings]{add_label_missings()}} \code{\link[=add_label_shadow]{add_label_shadow()}} \code{\link[=add_miss_cluster]{add_miss_cluster()}} \code{\link[=add_n_miss]{add_n_miss()}} \code{\link[=add_prop_miss]{add_prop_miss()}} \code{\link[=add_shadow]{add_shadow()}} \code{\link[=add_shadow_shift]{add_shadow_shift()}} \code{\link[=as_shadow]{as_shadow()}} \code{\link[=bind_shadow]{bind_shadow()}} \code{\link[=cast_shadow]{cast_shadow()}} \code{\link[=cast_shadow_shift]{cast_shadow_shift()}} \code{\link[=cast_shadow_shift_label]{cast_shadow_shift_label()}} \code{\link[=draw_key_missing_point]{draw_key_missing_point()}} \code{\link[=gather_shadow]{gather_shadow()}} \code{\link[=geom_miss_point]{geom_miss_point()}} \code{\link[=gg_miss_case]{gg_miss_case()}} \code{\link[=gg_miss_case_cumsum]{gg_miss_case_cumsum()}} \code{\link[=gg_miss_fct]{gg_miss_fct()}} \code{\link[=gg_miss_span]{gg_miss_span()}} \code{\link[=gg_miss_var]{gg_miss_var()}} \code{\link[=gg_miss_var_cumsum]{gg_miss_var_cumsum()}} \code{\link[=gg_miss_which]{gg_miss_which()}} \code{\link[=label_miss_1d]{label_miss_1d()}} \code{\link[=label_miss_2d]{label_miss_2d()}} \code{\link[=label_missings]{label_missings()}} \code{\link[=pct_miss_case]{pct_miss_case()}} \code{\link[=prop_miss_case]{prop_miss_case()}} \code{\link[=pct_miss_var]{pct_miss_var()}} \code{\link[=prop_miss_var]{prop_miss_var()}} \code{\link[=pct_complete_case]{pct_complete_case()}} \code{\link[=prop_complete_case]{prop_complete_case()}} \code{\link[=pct_complete_var]{pct_complete_var()}} \code{\link[=prop_complete_var]{prop_complete_var()}} \code{\link[=miss_prop_summary]{miss_prop_summary()}} \code{\link[=miss_case_summary]{miss_case_summary()}} \code{\link[=miss_case_table]{miss_case_table()}} \code{\link[=miss_summary]{miss_summary()}} \code{\link[=miss_var_prop]{miss_var_prop()}} \code{\link[=miss_var_run]{miss_var_run()}} \code{\link[=miss_var_span]{miss_var_span()}} \code{\link[=miss_var_summary]{miss_var_summary()}} \code{\link[=miss_var_table]{miss_var_table()}} \code{\link[=n_complete]{n_complete()}} \code{\link[=n_complete_row]{n_complete_row()}} \code{\link[=n_miss]{n_miss()}} \code{\link[=n_miss_row]{n_miss_row()}} \code{\link[=pct_complete]{pct_complete()}} \code{\link[=pct_miss]{pct_miss()}} \code{\link[=prop_complete]{prop_complete()}} \code{\link[=prop_complete_row]{prop_complete_row()}} \code{\link[=prop_miss]{prop_miss()}} \code{\link[=prop_miss_row]{prop_miss_row()}} \code{\link[=replace_to_na]{replace_to_na()}} \code{\link[=replace_with_na]{replace_with_na()}} \code{\link[=replace_with_na_all]{replace_with_na_all()}} \code{\link[=replace_with_na_at]{replace_with_na_at()}} \code{\link[=replace_with_na_if]{replace_with_na_if()}} \code{\link[=shadow_shift]{shadow_shift()}} \code{\link[=stat_miss_point]{stat_miss_point()}} \code{\link[=vis_miss]{vis_miss()}} \code{\link[=where_na]{where_na()}} } +\author{ +\strong{Maintainer}: Nicholas Tierney \email{nicholas.tierney@gmail.com} (\href{https://orcid.org/0000-0003-1460-8722}{ORCID}) + +Authors: +\itemize{ + \item Di Cook \email{dicook@monash.edu} (\href{https://orcid.org/0000-0002-3813-7155}{ORCID}) + \item Miles McBain \email{miles.mcbain@gmail.com} (\href{https://orcid.org/0000-0003-2865-2548}{ORCID}) + \item Colin Fay \email{contact@colinfay.me} (\href{https://orcid.org/0000-0001-7343-1846}{ORCID}) +} + +Other contributors: +\itemize{ + \item Mitchell O'Hara-Wild [contributor] + \item Jim Hester \email{james.f.hester@gmail.com} [contributor] + \item Luke Smith [contributor] + \item Andrew Heiss \email{andrew@andrewheiss.com} (\href{https://orcid.org/0000-0002-3948-3914}{ORCID}) [contributor] +} + +} diff --git a/tests/testthat/_snaps/add-label-shadow.md b/tests/testthat/_snaps/add-label-shadow.md index c56d1b67..f6793113 100644 --- a/tests/testthat/_snaps/add-label-shadow.md +++ b/tests/testthat/_snaps/add-label-shadow.md @@ -2,7 +2,8 @@ Code add_label_shadow(dat) - 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()` diff --git a/tests/testthat/_snaps/add-shadow.new.md b/tests/testthat/_snaps/add-shadow.new.md new file mode 100644 index 00000000..5103a043 --- /dev/null +++ b/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 + diff --git a/tests/testthat/_snaps/as-shadow.md b/tests/testthat/_snaps/as-shadow.md index 7d035b86..2edb4b2b 100644 --- a/tests/testthat/_snaps/as-shadow.md +++ b/tests/testthat/_snaps/as-shadow.md @@ -2,31 +2,35 @@ Code as_shadow(0) - Error - Input must inherit from + Condition + Error in `test_if_dataframe()`: + ! Input must inherit from We see class: --- Code as_shadow("a") - Error - Input must inherit from + Condition + Error in `test_if_dataframe()`: + ! Input must inherit from We see class: --- Code as_shadow(matrix(airquality)) - Error - Input must inherit from + Condition + Error in `test_if_dataframe()`: + ! Input must inherit from We see class: --- Code as_shadow(NULL) - Error - Input must not be NULL + Condition + Error in `test_if_null()`: + ! Input must not be NULL Input is diff --git a/tests/testthat/_snaps/as_shadow_upset.md b/tests/testthat/_snaps/as_shadow_upset.md index 98fa0bd2..94caaa95 100644 --- a/tests/testthat/_snaps/as_shadow_upset.md +++ b/tests/testthat/_snaps/as_shadow_upset.md @@ -2,48 +2,55 @@ Code as_shadow_upset(diag_na(1)) - Error - upset plots for missing data requre at least two variables to have missing data, only one variable, 'x1' has missing values. + Condition + Error in `as_shadow_upset()`: + ! upset plots for missing data requre at least two variables to have missing data, only one variable, 'x1' has missing values. --- Code as_shadow_upset(data.frame(x = NA)) - Error - upset plots for missing data requre at least two variables to have missing data, only one variable, 'x' has missing values. + Condition + Error in `as_shadow_upset()`: + ! upset plots for missing data requre at least two variables to have missing data, only one variable, 'x' has missing values. --- Code as_shadow_upset(data.frame(numeric(0))) - Error - upset plots for missing data requre at least two variables to have missing data, there are no missing values in your data! This is probably a good thing. + Condition + Error in `as_shadow_upset()`: + ! upset plots for missing data requre at least two variables to have missing data, there are no missing values in your data! This is probably a good thing. # as_shadow_upset errors when given non dataframe or 0 entry Code as_shadow_upset(0) - Error - 'x' must be an array of at least two dimensions + Condition + Error in `colSums()`: + ! 'x' must be an array of at least two dimensions --- Code as_shadow_upset("a") - Error - 'x' must be an array of at least two dimensions + Condition + Error in `colSums()`: + ! 'x' must be an array of at least two dimensions --- Code as_shadow_upset(matrix(airquality)) - Error - upset plots for missing data requre at least two variables to have missing data, there are no missing values in your data! This is probably a good thing. + Condition + Error in `as_shadow_upset()`: + ! upset plots for missing data requre at least two variables to have missing data, there are no missing values in your data! This is probably a good thing. --- Code as_shadow_upset(NULL) - Error - 'x' must be an array of at least two dimensions + Condition + Error in `colSums()`: + ! 'x' must be an array of at least two dimensions diff --git a/tests/testthat/_snaps/replace-with-na-scoped-var.md b/tests/testthat/_snaps/replace-with-na-scoped-var.md index 5b8edab2..fcfcde80 100644 --- a/tests/testthat/_snaps/replace-with-na-scoped-var.md +++ b/tests/testthat/_snaps/replace-with-na-scoped-var.md @@ -2,9 +2,6 @@ Code replace_with_na_all(df) - Error - i In index: 1. - i With name: x. - Caused by error in `.f()`: - ! argument "condition" is missing, with no default + Error + argument "condition" is missing, with no default