diff --git a/R/formatters_var_labels.R b/R/formatters_var_labels.R index b012d2c72..186e68ad0 100644 --- a/R/formatters_var_labels.R +++ b/R/formatters_var_labels.R @@ -84,16 +84,22 @@ col_labels <- function(x, fill = FALSE) { names(x) } else if (any(names(value) == "")) { specified_cols <- names(value)[names(value) != ""] - checkmate::assert_subset(specified_cols, names(x), .var.name = "column names") + checkmate::assert_subset(specified_cols, names(x), .var.name = "names of value") res <- names(value) res[res == ""] <- setdiff(names(x), specified_cols) res } else { - checkmate::assert_set_equal(names(value), names(x), .var.name = "column names") + checkmate::assert_set_equal(names(value), names(x), .var.name = "names of value") names(value) } - x[varnames] <- mapply(`attr<-`, x = x[varnames], which = "label", value = value, SIMPLIFY = FALSE) + for (i in seq_along(value)) { + if (is.na(value[i])) { + attr(x[[varnames[i]]], "label") <- NULL + } else { + attr(x[[varnames[i]]], "label") <- value[[i]] + } + } x } @@ -108,8 +114,14 @@ col_relabel <- function(x, ...) { varnames <- names(value) checkmate::assert_subset(varnames, names(x), .var.name = "names of ...") - lapply(value, checkmate::assert_string, .var.name = "element of ...") + lapply(value, checkmate::assert_string, .var.name = "element of ...", na.ok = TRUE) - x[varnames] <- mapply(`attr<-`, x = x[varnames], which = "label", value = value, SIMPLIFY = FALSE) + for (i in seq_along(value)) { + if (is.na(value[i])) { + attr(x[[varnames[i]]], "label") <- NULL + } else { + attr(x[[varnames[i]]], "label") <- value[[i]] + } + } x } diff --git a/tests/testthat/test-formatters_var_labels.R b/tests/testthat/test-formatters_var_labels.R index 5f8383190..0cfad914a 100644 --- a/tests/testthat/test-formatters_var_labels.R +++ b/tests/testthat/test-formatters_var_labels.R @@ -80,7 +80,7 @@ testthat::test_that("col_labels<- value names must be same as variable names", { iris_df <- utils::head(iris, 2) testthat::expect_error( col_labels(iris_df) <- stats::setNames(as.character(1:5), toupper(names(iris_df))), - "Assertion on 'column names' failed: Must be a permutation of set" + "Assertion on 'names of value' failed: Must be a permutation of set" ) }) @@ -132,6 +132,16 @@ testthat::test_that("col_labels<- matches labels to variables by names of values ) }) +testthat::test_that("col_labels<- removes labels on NA_character_", { + x <- data.frame(a = 1, b = 2, c = 3) + col_labels(x) <- c("A", "B", "C") + col_labels(x) <- c(b = NA, "AA", NA) + testthat::expect_identical( + col_labels(x), + c(a = "AA", b = NA, c = NA) + ) +}) + # col_relabel ---- testthat::test_that("col_relabel correctly changes column labels in a data frame", { @@ -154,3 +164,13 @@ testthat::test_that("col_relabel returns the original data.frame when no new lab iris_df <- col_relabel(iris) testthat::expect_equal(iris_df, iris) }) + +testthat::test_that("col_relabel removes labels on NA_character_", { + x <- data.frame(a = 1, b = 2, c = 3) + col_labels(x) <- c("A", "B", "C") + x <- col_relabel(x, b = NA_character_) + testthat::expect_identical( + col_labels(x), + c(a = "A", b = NA, c = "C") + ) +})