diff --git a/R/utils_compact.R b/R/utils_compact.R index 724b72672..19f5562c8 100644 --- a/R/utils_compact.R +++ b/R/utils_compact.R @@ -9,6 +9,13 @@ #' compact_list(c(1, NA, NA), remove_na = TRUE) #' @export compact_list <- function(x, remove_na = FALSE) { + # remove vctr-class attributes + if (is.data.frame(x)) { + x[] <- lapply(x, function(i) { + class(i) <- setdiff(class(i), c("haven_labelled", "vctrs_vctr")) + i + }) + } if (remove_na) { x[!sapply(x, function(i) !is_model(i) && !inherits(i, c("Formula", "gFormula")) && (length(i) == 0L || is.null(i) || (length(i) == 1L && is.na(i)) || all(is.na(i)) || any(i == "NULL", na.rm = TRUE)))] } else { @@ -30,5 +37,5 @@ compact_list <- function(x, remove_na = FALSE) { #' #' @export compact_character <- function(x) { - x[!sapply(x, function(i) nchar(i) == 0 || all(is.na(i)) || any(i == "NULL", na.rm = TRUE))] + x[!sapply(x, function(i) !nzchar(i, keepNA = TRUE) || all(is.na(i)) || any(i == "NULL", na.rm = TRUE))] } diff --git a/tests/testthat/test-compact-list.R b/tests/testthat/test-compact-list.R index a8a009613..6867c6fed 100644 --- a/tests/testthat/test-compact-list.R +++ b/tests/testthat/test-compact-list.R @@ -1,19 +1,27 @@ test_that("compact_list works as expected", { - expect_equal(compact_list(list(NULL, 1, c(NA, NA))), list(1, c(NA, NA))) - expect_equal(compact_list(c(1, NA, NA)), c(1, NA, NA)) - expect_equal(compact_list(list(NULL, 1, list(NULL, NULL))), list(1)) - expect_equal(compact_list(c(1, NA, NA), remove_na = TRUE), 1) - expect_equal(compact_list(c(1, 2, 3), remove_na = TRUE), c(1, 2, 3)) - expect_equal(compact_list(""), "") + expect_identical(compact_list(list(NULL, 1, c(NA, NA))), list(1, c(NA, NA))) + expect_identical(compact_list(c(1, NA, NA)), c(1, NA, NA)) + expect_identical(compact_list(list(NULL, 1, list(NULL, NULL))), list(1)) + expect_identical(compact_list(c(1, NA, NA), remove_na = TRUE), 1) + expect_identical(compact_list(c(1, 2, 3), remove_na = TRUE), c(1, 2, 3)) + expect_identical(compact_list(""), "") expect_null(compact_list(NULL)) - expect_equal(compact_list(logical(0)), logical(0)) + expect_identical(compact_list(logical(0)), logical(0)) }) test_that("compact_list, logical > 1", { x <- list(a = 1, b = c(1, 2), c = NA) - expect_equal(compact_list(x, remove_na = TRUE), list(a = 1, b = c(1, 2))) - expect_equal(compact_list(x, remove_na = FALSE), list(a = 1, b = c(1, 2), c = NA)) + expect_identical(compact_list(x, remove_na = TRUE), list(a = 1, b = c(1, 2))) + expect_identical(compact_list(x, remove_na = FALSE), list(a = 1, b = c(1, 2), c = NA)) x <- list(a = 1, b = c(NA, NA), c = NA) - expect_equal(compact_list(x, remove_na = TRUE), list(a = 1)) - expect_equal(compact_list(x, remove_na = FALSE), list(a = 1, b = c(NA, NA), c = NA)) + expect_identical(compact_list(x, remove_na = TRUE), list(a = 1)) + expect_identical(compact_list(x, remove_na = FALSE), list(a = 1, b = c(NA, NA), c = NA)) +}) + +test_that("compact_list, vctrs", { + data(mtcars) + class(mtcars$mpg) <- c("haven_labelled", "vctrs_vctr", "double") + attr(mtcars$mpg, "labels") <- c(`21` = 21) + out <- compact_list(mtcars) + expect_true(all(vapply(out, class, character(1)) == "numeric")) })