From c67e83e3552b0f1dba1c392ca8fc7bb421b5a593 Mon Sep 17 00:00:00 2001 From: Emil Hvitfeldt Date: Mon, 9 Sep 2024 12:17:48 -0700 Subject: [PATCH] complete.cases() -> vec_detect_complete() --- NAMESPACE | 2 +- R/case_weights.R | 2 +- R/classdist.R | 2 +- R/classdist_shrunken.R | 2 +- R/corr.R | 2 +- R/impute_bag.R | 4 ++-- R/impute_knn.R | 4 ++-- R/impute_linear.R | 6 +++--- R/misc.R | 4 ++-- R/recipes-package.R | 2 +- man/step_classdist.Rd | 2 +- man/step_classdist_shrunken.Rd | 2 +- tests/testthat/test-dummy.R | 10 +++++----- 13 files changed, 22 insertions(+), 22 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index ed6a8d583..226e43be3 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -765,7 +765,6 @@ importFrom(purrr,map_dbl) importFrom(purrr,map_lgl) importFrom(stats,as.formula) importFrom(stats,binomial) -importFrom(stats,complete.cases) importFrom(stats,cov) importFrom(stats,cov.wt) importFrom(stats,lm) @@ -794,4 +793,5 @@ importFrom(utils,install.packages) importFrom(utils,object.size) importFrom(vctrs,vec_cast) importFrom(vctrs,vec_cbind) +importFrom(vctrs,vec_detect_complete) importFrom(vctrs,vec_slice) diff --git a/R/case_weights.R b/R/case_weights.R index f949dd2aa..1fbfe3584 100644 --- a/R/case_weights.R +++ b/R/case_weights.R @@ -131,7 +131,7 @@ wt_calcs <- function(x, wts, statistic = "mean") { wts <- rep(1L, nrow(x)) } - complete <- stats::complete.cases(x) & !is.na(wts) + complete <- vec_detect_complete(x) & !is.na(wts) wts <- wts[complete] x <- x[complete,,drop = FALSE] res <- stats::cov.wt(x, wt = wts, cor = statistic == "cor") diff --git a/R/classdist.R b/R/classdist.R index c7c72f7da..639a5a4d4 100644 --- a/R/classdist.R +++ b/R/classdist.R @@ -58,7 +58,7 @@ #' #' @examplesIf rlang::is_installed(c("modeldata")) #' data(penguins, package = "modeldata") -#' penguins <- penguins[complete.cases(penguins), ] +#' penguins <- penguins[vctrs::vec_detect_complete(penguins), ] #' penguins$island <- NULL #' penguins$sex <- NULL #' diff --git a/R/classdist_shrunken.R b/R/classdist_shrunken.R index 28cdc8f1f..1b277abcf 100644 --- a/R/classdist_shrunken.R +++ b/R/classdist_shrunken.R @@ -62,7 +62,7 @@ #' of the National Academy of Sciences_, 99(10), 6567-6572. #' @examplesIf rlang::is_installed(c("modeldata")) #' data(penguins, package = "modeldata") -#' penguins <- penguins[complete.cases(penguins), ] +#' penguins <- penguins[vctrs::vec_detect_complete(penguins), ] #' penguins$island <- NULL #' penguins$sex <- NULL #' diff --git a/R/corr.R b/R/corr.R index 0aee863b0..76f219f48 100644 --- a/R/corr.R +++ b/R/corr.R @@ -185,7 +185,7 @@ corr_filter <- method = "pearson") { x <- correlations(x, wts = wts, use = use, method = method) - if (any(!complete.cases(x))) { + if (any(!vec_detect_complete(x))) { all_na <- apply(x, 2, function(x) all(is.na(x))) if (sum(all_na) >= nrow(x) - 1) { cli::cli_warn( diff --git a/R/impute_bag.R b/R/impute_bag.R index 857703304..990be8381 100644 --- a/R/impute_bag.R +++ b/R/impute_bag.R @@ -248,14 +248,14 @@ bake.step_impute_bag <- function(object, new_data, ...) { col_names <- names(object$models) check_new_data(col_names, object, new_data) - missing_rows <- !complete.cases(new_data) + missing_rows <- !vec_detect_complete(new_data) if (!any(missing_rows)) { return(new_data) } old_data <- new_data for (col_name in col_names) { - missing_rows <- !complete.cases(new_data[[col_name]]) + missing_rows <- !vec_detect_complete(new_data[[col_name]]) if (!any(missing_rows)) { next } diff --git a/R/impute_knn.R b/R/impute_knn.R index bbd17b242..e06eb9cfb 100644 --- a/R/impute_knn.R +++ b/R/impute_knn.R @@ -221,7 +221,7 @@ bake.step_impute_knn <- function(object, new_data, ...) { all_cols <- unique(unlist(object$columns, recursive = TRUE)) check_new_data(all_cols, object, new_data) - missing_rows <- !complete.cases(new_data) + missing_rows <- !vec_detect_complete(new_data) if (!any(missing_rows)) { return(new_data) } @@ -230,7 +230,7 @@ bake.step_impute_knn <- function(object, new_data, ...) { old_data <- new_data for (col_name in col_names) { - missing_rows <- !complete.cases(new_data[, col_name]) + missing_rows <- !vec_detect_complete(new_data[, col_name]) if (!any(missing_rows)) { next } diff --git a/R/impute_linear.R b/R/impute_linear.R index ce8e73117..c95dfccfa 100644 --- a/R/impute_linear.R +++ b/R/impute_linear.R @@ -115,7 +115,7 @@ step_impute_linear_new <- lm_wrap <- function(vars, dat, wts = NULL, call = caller_env(2)) { dat <- as.data.frame(dat[, c(vars$y, vars$x)]) - complete <- stats::complete.cases(dat) + complete <- vec_detect_complete(dat) dat <- dat[complete, ] wts <- wts[complete] if (nrow(dat) == 0) { @@ -200,14 +200,14 @@ bake.step_impute_linear <- function(object, new_data, ...) { col_names <- names(object$models) check_new_data(col_names, object, new_data) - missing_rows <- !complete.cases(new_data) + missing_rows <- !vec_detect_complete(new_data) if (!any(missing_rows)) { return(new_data) } old_data <- new_data for (col_name in col_names) { - missing_rows <- !complete.cases(new_data[[col_name]]) + missing_rows <- !vec_detect_complete(new_data[[col_name]]) if (!any(missing_rows)) { next } diff --git a/R/misc.R b/R/misc.R index 502b2ad51..f11ebb4d3 100644 --- a/R/misc.R +++ b/R/misc.R @@ -206,7 +206,7 @@ strings2factors <- function(x, info) { # ------------------------------------------------------------------------------ -# `complete.cases` fails on list columns. This version counts a list column +# `vec_detect_complete` fails on list columns. This version counts a list column # as missing if _all_ values are missing. For if a list vector element is a # data frame with one missing value, that element of the list column will # be counted as complete. @@ -218,7 +218,7 @@ n_complete_rows <- function(x) { x[[pos_list_col]] <- purrr::map_lgl(x[[pos_list_col]], flatten_na) } - sum(complete.cases(x)) + sum(vec_detect_complete(x)) } flatten_na <- function(x) { diff --git a/R/recipes-package.R b/R/recipes-package.R index 636d085bf..3be7e3d33 100644 --- a/R/recipes-package.R +++ b/R/recipes-package.R @@ -71,7 +71,6 @@ #' @importFrom purrr map_lgl #' @importFrom stats as.formula #' @importFrom stats binomial -#' @importFrom stats complete.cases #' @importFrom stats cov #' @importFrom stats cov.wt #' @importFrom stats lm @@ -99,6 +98,7 @@ #' @importFrom utils object.size #' @importFrom vctrs vec_cast #' @importFrom vctrs vec_cbind +#' @importFrom vctrs vec_detect_complete #' @importFrom vctrs vec_slice ## usethis namespace: end NULL diff --git a/man/step_classdist.Rd b/man/step_classdist.Rd index 2e8519d48..a5234054d 100644 --- a/man/step_classdist.Rd +++ b/man/step_classdist.Rd @@ -121,7 +121,7 @@ importance weights. For more information,, see the documentation in \examples{ \dontshow{if (rlang::is_installed(c("modeldata"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(penguins, package = "modeldata") -penguins <- penguins[complete.cases(penguins), ] +penguins <- penguins[vctrs::vec_detect_complete(penguins), ] penguins$island <- NULL penguins$sex <- NULL diff --git a/man/step_classdist_shrunken.Rd b/man/step_classdist_shrunken.Rd index 7e60b7a1c..7dd7b9a73 100644 --- a/man/step_classdist_shrunken.Rd +++ b/man/step_classdist_shrunken.Rd @@ -125,7 +125,7 @@ importance weights. For more information,, see the documentation in \examples{ \dontshow{if (rlang::is_installed(c("modeldata"))) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} data(penguins, package = "modeldata") -penguins <- penguins[complete.cases(penguins), ] +penguins <- penguins[vctrs::vec_detect_complete(penguins), ] penguins$island <- NULL penguins$sex <- NULL diff --git a/tests/testthat/test-dummy.R b/tests/testthat/test-dummy.R index e411271e0..203465b09 100644 --- a/tests/testthat/test-dummy.R +++ b/tests/testthat/test-dummy.R @@ -15,7 +15,7 @@ sacr$city[sample(1:nrow(sacr), 20)] <- NA_character_ sacr_missing <- sacr sacr$city[is.na(sacr$city)] <- "missing" -sacr <- sacr[complete.cases(sacr), -3] +sacr <- sacr[vec_detect_complete(sacr), -3] sacr_fac <- sacr sacr_fac$city <- factor(sacr_fac$city) @@ -167,10 +167,10 @@ test_that("tests for NA values in factor", { ) expect_true( - all(complete.cases(factors_data_0) == complete.cases(sacr_missing[, "city"])) + all(vec_detect_complete(factors_data_0) == vec_detect_complete(sacr_missing[, "city"])) ) expect_true( - all(complete.cases(factors_data_1) == complete.cases(sacr_missing[, "city"])) + all(vec_detect_complete(factors_data_1) == vec_detect_complete(sacr_missing[, "city"])) ) }) @@ -189,10 +189,10 @@ test_that("tests for NA values in ordered factor", { ) expect_true( - all(complete.cases(factors_data_0) == complete.cases(sacr_ordered[, "city"])) + all(vec_detect_complete(factors_data_0) == vec_detect_complete(sacr_ordered[, "city"])) ) expect_true( - all(complete.cases(factors_data_1) == complete.cases(sacr_ordered[, "city"])) + all(vec_detect_complete(factors_data_1) == vec_detect_complete(sacr_ordered[, "city"])) ) })